home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / rbbs_pc / rbbsbas.zip / RBBSSUB2.BAS < prev    next >
BASIC Source File  |  1988-10-02  |  131KB  |  3,661 lines
  1. ' $linesize:132
  2. ' $title: 'RBBSSUB2.BAS CPC17-1A, Copyright 1986 - 88 by D. Thomas Mack'
  3. '  Copyright 1987 by D. Thomas Mack, all rights reserved.
  4. '  Name ...............: RBBSSUB2.BAS
  5. '  Written by .........: D. Thomas Mack
  6. '  First Released .....: September 18, 1988
  7. '  Subsequent Releases.:
  8. '  Copyright ..........: 1986, 1987, 1988
  9. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  10. '                        RBBS-PC.BAS utilizes a lot of common subroutines.
  11. '                        Those that do not require error trapping are
  12. '                        incorporated within RBBSSUB2.BAS, RBBSSUB3.BAS,
  13. '                        RBBSSUB4.BAS and RBBSSUB5.BAS as separately
  14. '                        callable subroutines in order to free up as much
  15. '                        code as possible within the 64K code segment
  16. '                        used by RBBS-PC.BAS.
  17. '  Parameters..........: Most parameters are passed via a COMMON statement.
  18. '
  19. ' Subroutine  Line               Function of Subroutine
  20. '   Name     Number
  21. '  ANSWERIT     201   Answer the telephone when it rings
  22. '  ASCCODES     129   Allow a CONFIG string to have any ASCII value
  23. '  BADCHAR      455   Check user name for invalid characters
  24. '  BADNAME    20235   Check for system crash attempt with bad file name
  25. '  BAUD450     5507   Allow 300 baud callers to bump up to 450 baud
  26. '  BRKFNAME   20282   Break a file name into it's component parts
  27. '  CHECKRATIO 20096   Test upload/download ratio
  28. '  CHKMACRO    1242   Checks for macro and processes
  29. '  COPYWRIT      97   Display RBBS-PC's copyright notice
  30. '  DEFALTU     9600   Write out the user's defaults
  31. '  DENYACCESS  1386   Downgrade security so access denied
  32. '  DOOREXIT   10987   Set up a .BAT file to exit RBBS-PC and go to a "door"
  33. '  DOSEXIT    10934   Set up a .BAT file to exit to DOS (second level)
  34. '  EDITALINE   2620   Edits a single line
  35. '  EDITDEF            Edit configuration parameters
  36. '  GETARC     20141   Handle request for verbose arc listing
  37. '  GETCOMND      97+  Get RBBS-PC's node id from command line
  38. '  GETIME      9140   Calculates callers elapsed time (hours, minutes, seconds)
  39. '  GOIDLE        90   Release resources when waiting for keyboard input
  40. '  KILLMSG     3955   Delete old or unnecessary messages
  41. '  LINE25       949   Build and/or update line 25 of RBBS-PC's local screen
  42. '  LINEEDIT    3700   Edit a line while minimizing string space consumption
  43. '  LOGERROR   13660   Log error message to CALLERS file
  44. '  LPRNT       1480   Subroutine to write to local display
  45. '  MLINIT        10   Handle MultiLink initialization/de-initialization
  46. '  MSGPROT     2060   Sets protection for a message
  47. '  MSGTO       2020   Sets who a message is to
  48. '  PAGLEN      5902   Change page length
  49. '  PARSEIT     1635   Parses a string
  50. '  PASSWRD      667   Verify user & message passwords
  51. '  PSCRN       1480+  Print to display
  52. '  QTPUT       1477   Fast, but limited, "TPUT" equivalent
  53. '  RBBSEXIT   10992   Common RBBS-PC exit to transfer control to other programs
  54. '  RECOVMSG   10410   Recover a deleted message
  55. '  REMNONALF   5100   Removes non-alpha characters from a string
  56. '  RINGCALLER  1635+  Ring caller's bell and put message in emphasis
  57. '  SETBAUD     1654   Set baud rate in the 8250 chip of the RS232 interface
  58. '  SETCRLF     1496   Set up the necessary carriage return/line feed string
  59. '  SETSECT    12000   Set the proper section prompts (main, file, util, libr)
  60. '  SETTHREAD   4031   Set up request for threading thru messages
  61. '  SKIPLINE    1485   Write a # of blank lines to the communications port
  62. '  SRCHCMND    1240   Searches list of commands in RBBS for a request
  63. '  SVIOLATION  1380   Process a security violation
  64. '  SYSMENU      112   Displays sysop menu/status
  65. '  TESTREL      336   Tests for Reliable connect
  66. '  TGET        1500   Read a line from the communications port
  67. '  TPUT        1400   Write a line to the communications port
  68. '  TRIM          99   Strip leading and trailing blanks from a string
  69. '  TRIMTRAIL     99   Strip off specified string off end of another string
  70. '  UNTILRIGHT 12880   Ask a question until user says answer is right
  71. '  UPDATEU    10600   Updates the user record on loging off/exiting RBBS-PC
  72. '  VARINIT      104   Initialize system variables
  73. '  VIEWHELP    1330   Processes help command
  74. '  WHOCHECK    2250   Checks whether a user exists in user file
  75. '  WHOSON      9801   Report status of each node - who's on
  76. '  WILDCARD   20285   Determines whether string matches a pattern
  77. '  WORDINFILE 10976   Find a whole word within a file/menu
  78. '
  79. '  $INCLUDE: 'RBBS-VAR.BAS'
  80. '
  81. '  $SUBTITLE: 'MLINIT - MultiLink initialization/deinitialization'
  82. '  $PAGE
  83. '
  84. '  SUBROUTINE NAME    -- MLINIT
  85. '
  86. '  INPUT PARAMETERS   --  MLPARM = 1             INITIALIZE AT STARTUP OR RE-
  87. '                                                CYLCE TIME
  88. '                         MLPARM = 2             DE-INITIALIZE ON EXITING TO
  89. '                                                A DOOR OR DOS REMOTELY
  90. '                         MLPARM = 3             DE-QUEUE COMMUNICATIONS PORTS
  91. '                         MLPARM = 4             CHECK FOR MULTILINK PRESENT
  92. '                         DOORS.TERMINAL.TYPE
  93. '                         BAUD.TEST
  94. '                         COM.PORT$
  95. '                         COMPUTER.TYPE
  96. '
  97. '  OUTPUT PARAMETERS  --  NONE
  98. '
  99. '  SUBROUTINE PURPOSE --  TO TEST FOR THE PRESENCE OF MULTI-LINK AND SET
  100. '                         MULTI LINK OPTIONS TO BE COMPATIBLE WITH RBBS-PC
  101. '
  102.       SUB MLINIT (MLPARM) STATIC
  103.     DEF SEG = 0
  104.     IF COMPUTER.TYPE = 1 _
  105.        GOTO 10
  106.     IF NOT MLCOM THEN _
  107.        IF NETWORK.TYPE <> 1 THEN _
  108.           GOTO 10
  109.     MULTI.LINK.PRESENT = PEEK(&H1FE) + 256 * PEEK(&H1FF)
  110.     IF MULTI.LINK.PRESENT = 0 THEN _
  111.        GOTO 10
  112.     ON MLPARM GOSUB 30,20,60,10
  113. 10  DEF SEG
  114.     EXIT SUB
  115. 20  IF DOORS.TERMINAL.TYPE < 1 THEN _
  116.        RETURN
  117.     DEF SEG = MULTI.LINK.PRESENT
  118.     GOSUB 60
  119. ' **************     MLUTIL BAUD n (where n = BAUD.TEST)  *******
  120.     AX = &H600
  121.     BX = BAUD.TEST   ' Tell ML the baud rate
  122.     GOSUB 80
  123. ' **************     MLUTIL TERM n (where n = DOORS.TERMINAL.TYPE) *****
  124.     AX = &H700 + DOORS.TERMINAL.TYPE
  125.     GOSUB 80         ' Tell ML the terminal type
  126. ' *********          MLINK /port       ************
  127. '                    ' Tell ML the communications port
  128.     POKE (&H64 + PEEK(&H58) + 256 * PEEK(&H59) + &HC),ASC(RIGHT$(COM.PORT$,1)) - 48
  129. ' ************       MLUTIL SCMON       **************
  130.     AX = &HB01
  131.     BX = 0           ' Tell ML to start monitoring the carrier
  132.     GOSUB 80
  133.     RETURN
  134. ' **************     MLUTIL CCMON       ****************
  135. 30  AX = &HB00       ' Turn off ML's carrier monitoring.
  136.     BX = 0
  137.     GOSUB 80
  138. ' **************     MLUTIL TERM 1       **************
  139.     AX = &H701       ' Change terminal type to ML type 1.
  140.     BX = 0
  141.     GOSUB 80
  142. ' *******  MLINK /port (where port = 9 if ML 3.03 or earlier  *******
  143. ' *******            port = 0 if ML 4.00 or greater           *******
  144.     DEF SEG = MULTI.LINK.PRESENT
  145.     MULTI.LINK.COM.PORT = (&H64 + PEEK(&H58) + 256 * PEEK(&H59) + &HC)
  146.     MULTI.LINK.VERSION = PEEK(&H1) + 256 * PEEK(&H2)
  147.     IF PEEK(MULTI.LINK.COM.PORT) = &H1 OR _
  148.        PEEK(MULTI.LINK.COM.PORT) = &H2 THEN _
  149.        IF MULTI.LINK.VERSION > 5000 THEN _
  150.           POKE (MULTI.LINK.COM.PORT),&H0 _
  151.        ELSE POKE (MULTI.LINK.COM.PORT),&H9
  152. ' **********         MLUTIL ENQ         ***********
  153.     AX = &H1        ' Tell ML to conditional enque on the comm. port
  154.     GOSUB 70
  155. ' **********         MLUTIL BAUD 19200      **********
  156.     AX = &H600       ' Tell ML to reset the buad rate (19200 BAUD)
  157.     BX = 19200
  158.     GOSUB 80
  159.     RETURN
  160. ' **********         MLUTIL DEQ         **********
  161. 60 AX = &H100        ' Tell ML to unconditionally deque the comm. port
  162. 70 BX = -4
  163.    IF COM.PORT$ = "COM2" THEN _
  164.       BX = -3
  165.    IF COM.PORT$ = "COM0" THEN _
  166.       RETURN
  167. ' ******  MULTI-LINK PROGRAMMING SUPPORT INTERFACE  ********
  168. 80 CALL RBBSML(AX,BX)
  169.    RETURN
  170.    END SUB
  171. '  $SUBTITLE: 'GOIDLE - subroutine to release control when waiting'
  172. '  $PAGE
  173. '
  174. '  SUBROUTINE NAME    -- GOIDLE
  175. '
  176. '  INPUT PARAMETERS   -- MLCOM
  177. '                        NETWORK.TYPE
  178. '
  179. '  OUTPUT PARAMETERS  --  NONE
  180. '
  181. '  SUBROUTINE PURPOSE --  TO RELINQUISH CONTROL WHEN RBBS-PC IS WAITING FOR
  182. '                         INPUT FROM THE COMMUNICATIONS PORT
  183. '
  184.       SUB GOIDLE STATIC
  185. 90 IF MLCOM OR NETWORK.TYPE = 1 THEN _
  186.       CALL MLINIT(5) : _
  187.       EXIT SUB
  188.    CALL GIVEBACK
  189.    END SUB
  190. '  $SUBTITLE: 'COPYWRIT - subroutine to display RBBS-PC copyright'
  191. '  $PAGE
  192. '
  193. '  SUBROUTINE NAME    -- COPYWRIT
  194. '
  195. '  INPUT PARAMETERS   --  NONE
  196. '
  197. '  OUTPUT PARAMETERS  --  NONE
  198. '
  199. '  SUBROUTINE PURPOSE --  TO DISPLAY RBBS-PC'S COPYRIGHT NOTICE ON THE LOCAL
  200. '                         SYSOP'S SCREEN
  201. '
  202.       SUB COPYWRIT STATIC
  203. 97 WIDTH 80
  204.    REDIM A$(11)
  205.    A$(1) = "If you use RBBS-PC CPC17-1A, please consider contributing to"
  206.    A$(2) = ""
  207.    A$(3) = "             Capital PC Software Exchange"
  208.    A$(4) = "                 Post Office Box 6128"
  209.    A$(5) = "            Silver Spring, Maryland  20906"
  210.    A$(6) = ""
  211.    A$(7) = "You are free to copy and share RBBS-PC CPC17-1A with"
  212.    A$(8) = "others on these three conditions:"
  213.    A$(09)= "  1.  This program is not distributed in modified form."
  214.    A$(10)= "  2.  No fee or consideration is charged for RBBS-PC, itself."
  215.    A$(11)= "  3.  This notice is not bypassed or removed."
  216.    CLS
  217.    KEY OFF
  218.    LOCATE ,,0
  219.    SNOOP = -1
  220.    LOCAL.USER = -1
  221.    CALL LPRNT(SPACE$(60) + "tm",1)
  222.    CALL LPRNT(SPACE$(16) + STRING$(15,205) + " U S E R W A R E " + STRING$(15,205),1)
  223.    CALL SKIPLINE(1)
  224.    CALL LPRNT(SPACE$(17) + "Capital PC User Group User-Supported Software",1)
  225.    CALL SKIPLINE (1)
  226.    CALL LPRNT(SPACE$(5) + CHR$(214) + STRING$(66,196) + CHR$(183),1)
  227.    FOR I = 1 TO 11
  228.       CALL LPRNT(SPACE$(5) + CHR$(186) + "    " + A$(I) + SPACE$(62 - LEN(A$(I))) + CHR$(186),1)
  229.    NEXT
  230.    CALL LPRNT(SPACE$(5) + CHR$(211) + STRING$(66,196) + CHR$(189),1)
  231.    CALL LPRNT(SPACE$(5) + "Copyright (c) 1983-88 Tom Mack, 39 Cranbury Drive, Trumbull, CT 06611",1)
  232.    CALL DELAYIT (8)
  233.    SNOOP = 0
  234.    END SUB
  235. ' $SUBTITLE: 'GETCOMND - subroutine to get command from command line'
  236. ' $PAGE
  237. '
  238. '  SUBROUTINE NAME    -- GETCOMND
  239. '
  240. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  241. '                        CONFIG.FILENAME$     NAME OF RBBS-PC ".DEF" FILE TO
  242. '                                             USE AS A MODEL WHEN CREATING THE
  243. '                                             .DEF FILE NAME TO BE USED BY THIS
  244. '                                             COPY OF RBBS-PC.
  245. '
  246. '                        COMMAND LINE         COMMAND LINE USED TO INVOKE
  247. '                                             RBBS-PC IN THE FORM:
  248. '
  249. '             RBBS-PC.EXE x filename DEBUG /time /baud
  250. '
  251. '   WHERE THE OPTIONAL PARAMETERS ARE:
  252. '
  253. '  x       IS THE NODE ID IN THE RANGE 1-9,0,A-Z
  254. ' filename IS THE FULLY QUALIFIED FILE NAME TO USE AS THE ".DEF" FILE
  255. ' DEBUG    IS A DEBUGGING SWITCH
  256. ' /time    IS THE TIME OF DAY FOR RBBS-PC TO RETURN TO THE CALLER
  257. ' /baud    IS THE BAUD RATE OF THE CALLER IF RBBS-PC IS BEING SHELLED TO BY
  258. '             ANOTHER COMMUNICATIONS PROGRAM (THE COMMUNICATIONS PORT BEING
  259. '             USED IS ASSUMED TO BE THE ONE INPUTTED VIA THE RBBS-PC CONFIG
  260. '             PROGRAM
  261. ' /reliable IS IF RELIABLE MODE WAS DETECTED BY A HOST MAILER
  262. '
  263. ' IF NO PARAMETERS ARE SUPPLIED, RBBS-PC ASSUMES THAT THE .DEF FILE NAME IS
  264. ' RBBS-PC.DEF AND THAT THE NODE IS NODE 1.
  265. '
  266. '  OUTPUT PARAMETERS  -- CONFIG.FILENAME$     NAME OF RBBS-PC ".DEF" FILE FOR
  267. '                                             THIS COPY OF RBBS-PC TO USE
  268. '                        NODE.RECORD.INDEX    RECORD NUMBER WITHIN THE
  269. '                                             MESSAGES FILE FOR THIS "NODE"
  270. '                                             (RANGE IS 2 TO 36)
  271. '
  272. '  SUBROUTINE PURPOSE --  TO GET NODE ID FROM COMMAND LINE
  273. '
  274.       SUB GETCOMND (PASSED.DEBUG,NETIME$,NETBAUD$,NETRELIABLE$) STATIC
  275.       STATIC DEBUG
  276. '
  277. ' *
  278. ' *  GET NODE ID FROM COMMAND LINE                                            *
  279. ' *
  280. '
  281.       PM$ = COMMAND$
  282.       CALL ALLCAPS(PM$)
  283.       IF INSTR(PM$,"/") = 0 THEN _
  284.          GOTO 98
  285. '
  286. ' *
  287. ' * PARSE THE COMMAND LINE FOR THREE POSITIONAL SWITCHES FOR NET MAIL           *
  288. ' *
  289. '
  290.       CMD.LINE$ = MID$(PM$,INSTR(PM$,"/"))
  291.       PM$ = LEFT$(PM$,INSTR(PM$,"/") - 1)
  292.       A = 0
  293.       FOR X = 1 TO LEN(CMD.LINE$)
  294.           IF MID$(CMD.LINE$,X,1) = "/" THEN _
  295.              A = A + 1 : _
  296.              WORK.ARA$(A) = "" _
  297.           ELSE WORK.ARA$(A) = WORK.ARA$(A) + MID$(CMD.LINE$,X,1)
  298.       NEXT
  299.       NETIME$ = WORK.ARA$(1)
  300.       IF A > 1 THEN _
  301.          NETBAUD$ = WORK.ARA$(2)
  302.       IF A > 2 THEN _
  303.          NETRELIABLE$ = WORK.ARA$(3)
  304.       CALL TRIM(NETIME$)
  305.       CALL TRIM(NETBAUD$)
  306.       CALL TRIM(NETRELIABLE$)
  307. 98    A = INSTR(PM$,"DEBUG")
  308.       IF A > 0 THEN _
  309.          DEBUG = -1 : _
  310.          PM$ = LEFT$(PM$,A - 1) + _
  311.                RIGHT$(PM$,LEN(PM$) - A - 4)
  312.       PASSED.DEBUG = DEBUG
  313.       IF LEN(PM$) = 0 THEN _
  314.          PM$ = "-"
  315.       NODE.RECORD.INDEX = INSTR("-1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ",LEFT$(PM$,1))
  316.       IF NODE.RECORD.INDEX < 2 THEN _
  317.          NODE.RECORD.INDEX = 2
  318.       NODE.ID$ = MID$(STR$(NODE.RECORD.INDEX-1),2)
  319.       IF NODE.RECORD.INDEX > 11 THEN _
  320.          NODE.FILE.ID$ = LEFT$(PM$,1) _
  321.       ELSE NODE.FILE.ID$ = NODE.ID$
  322.       IF NODE.ID$ <> "1" THEN _
  323.          LIBRARY.NODE.ID$ = NODE.FILE.ID$
  324.       IF LEN(PM$) > 2 AND MID$(PM$,2,1) = " " THEN _
  325.          CONFIG.FILENAME$ = MID$(PM$,3)_
  326.       ELSE MID$(CONFIG.FILENAME$,5,1) = PM$
  327.       ORIG.CONFIG$ = CONFIG.FILENAME$
  328.       END SUB
  329. ' $SUBTITLE: 'TRIM - subroutine to eliminate leading/trailing blanks'
  330. ' $PAGE
  331. '
  332. '  SUBROUTINE NAME    -- TRIM
  333. '
  334. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  335. '                        TRIM.PARM$           STRING THAT IS TO HAVE LEADING
  336. '                                             AND TRAILING BLANKS ELIMINATED
  337. '                                             FROM
  338. '
  339. '  OUTPUT PARAMETERS  -- TRIM.PARM$           STRING WITH NO LEADING OR TRAIL-
  340. '                                             ING BLANKS
  341. '
  342. '  SUBROUTINE PURPOSE --  TO STRIP LEADING AND TRAILING BLANKS
  343. '
  344.       SUB TRIM (TRIM.PARM$) STATIC
  345. 99    L = INSTR(TRIM.PARM$," ")
  346.       IF L < 1 THEN _
  347.          EXIT SUB
  348.       IF L = 1 THEN _
  349.          WHILE LEFT$(TRIM.PARM$,1) = " " : _
  350.             TRIM.PARM$ = RIGHT$(TRIM.PARM$,LEN(TRIM.PARM$) - 1) : _
  351.          WEND
  352.       CALL TRIMTRAIL (TRIM.PARM$," ")
  353.       END SUB
  354. '
  355. '  $SUBTITLE: 'TRIMTRAIL - subroutine to trim off trailing characters'
  356. '  $PAGE
  357. '
  358. '  SUBROUTINE NAME    --  TRIMTRAIL
  359. '
  360. '  INPUT PARAMETERS   --  PARAMETER           MEANING
  361. '                         TRIM.PARM$  TIME IN SECONDS AFTER MIDNIGHT TO WAIT
  362. '                                     BEFORE DISPLAYING
  363. '                         TRIM.THIS$  WHAT CHARACTER TO TRIM OFF END
  364. '
  365. '  OUTPUT PARAMETERS  --  NONE
  366. '
  367. '  SUBROUTINE PURPOSE --  TO DISPLAY RBBS-PC's SYSOP MENU ON THE LOCAL SCREEN
  368. '
  369.       SUB TRIMTRAIL (TRIM.PARM$,TRIM.THIS$) STATIC
  370.       WHILE RIGHT$(TRIM.PARM$,1) = TRIM.THIS$
  371.          TRIM.PARM$ = LEFT$(TRIM.PARM$,LEN(TRIM.PARM$) - 1)
  372.       WEND
  373.       END SUB
  374. '
  375. '  $SUBTITLE: 'VARINIT - subroutine to initialize system variables'
  376. '  $PAGE
  377. '
  378. '  SUBROUTINE NAME    --  VARINIT
  379. '
  380. '  INPUT PARAMETERS   --  PARAMETER           MEANING
  381. '                         NONE
  382. '
  383. '  OUTPUT PARAMETERS  --  NONE
  384. '
  385. '  SUBROUTINE PURPOSE --  TO INITIAIZE SYSTEM VARIABLES
  386. '
  387.       SUB VARINIT STATIC
  388. 104 ACKNOWLEDGE$ = CHR$(6)
  389.     ACKC$ = "C" + _
  390.             ACKNOWLEDGE$
  391.     ACTIVE.MENU$ = "B"
  392.     ACTIVE.MESSAGE$ = CHR$(225)
  393.     BACKSPACE$ = CHR$(8) + _
  394.                  CHR$(32) + _
  395.                  CHR$(8)
  396.     BACK.ARROW$ = CHR$(29) + _
  397.                   CHR$(32) + _
  398.                   CHR$(29)
  399.     BELL.RINGER$ = CHR$(7)
  400.     BULLETIN.MENU$ = ""
  401.     C.L = 24
  402.     CANCEL$ = CHR$(24)
  403.     COLOR.RESET$ = CHR$(27) + _
  404.                    "[00;37;40m"
  405.     CONFIG.FILENAME$ = "RBBS-PC.DEF"
  406.     CARRIAGE.RETURN$ = CHR$(13)
  407.     DELETED.MESSAGE$ = CHR$(226)
  408.     DOS.VERSION = 2
  409.     END.TRANSMISSION$ = CHR$(4)
  410.     ESCAPE$ = CHR$(27)
  411.     EXPECT.ACTIVE.MODEM = 0
  412.     FALSE = 0
  413.     F1.KEY = 59
  414.     F10.KEY = 68
  415.     GRN$ = "MAIN"
  416.     CALL SETHILITE (TRUE)
  417.     HOME.CONFERENCE$ = ""
  418.     IN.CONF.MENU = -1
  419.     LIMIT.MINUTES.PER.SESSION! = 0
  420.     LINE.FEED$ = CHR$(10)
  421.     LINE.FEEDS = NOT FALSE
  422.     LINEEDIT.CHK$ = CHR$(9) + _
  423.                     LINE.FEED$ + _
  424.                     CHR$(11) + _
  425.                     CHR$(12) + _
  426.                     CHR$(127) + _
  427.                     CHR$(8) + _
  428.                     BELL.RINGER$ + _
  429.                     CHR$(26) + _
  430.                     CHR$(227)
  431.     LINEMES$ = SPACE$(78)          ' fixed length string workspace
  432.     LOCK.STATUS$ = "UM UU UB UD"
  433.     MENU.INDEX = 2
  434.     NEGATIVE.ACKNOWLEDGE$ = CHR$(21)
  435.     NO.ADVANCE = FALSE
  436.     PAGE.LENGTH = 23
  437.     PARSE.OFF = FALSE
  438.     PRESS.ENTER$ = " (Press [ENTER] to quit)"
  439.     PRESS.ENTER.EXPERT$ = " ([ENTER] quits)"
  440.     PRESS.ENTER.NOVICE$ = PRESS.ENTER$
  441.     PRIVATE.DOOR = FALSE
  442.     RIGHT.MARGIN = 72
  443.     RETURN.LINE.FEED$ = CARRIAGE.RETURN$ + _
  444.                         LINE.FEED$
  445.     SMART.TABLE$ = "CS PB NS FN LN SL DT TM TR TE TL RP RR CT " + _
  446.                    "C1 C2 C3 C4 C0 DD BD DB UB DL UL"
  447.     START.OF.HEADER$ = CHR$(1)
  448.     TIME.LOGGED.ON$ = SPACE$(8)
  449.     TRUE = NOT FALSE
  450.     UPINC = -1
  451.     XOFF$ = CHR$(19)
  452.     XON$ = CHR$(17)
  453.     INTERRUPT.ON$ = CHR$(11) + CANCEL$ + XOFF$ + XON$ + CARRIAGE.RETURN$
  454.     OPTION.END$ = RETURN.LINE.FEED$ + " ,("
  455.     CRLF$ = CARRIAGE.RETURN$ + LINE.FEED$
  456.     LG$(1) = "Registration Check Failed"
  457.     LG$(2) = "Sysop name attempted"
  458.     LG$(3) = "Locked out attempt"
  459.     LG$(4) = "Password Attempt Failed"
  460.     LG$(5) = "Auto Lockout done"
  461.     LG$(6) = "Name in use on another Node!"
  462.     LG$(7) = ""
  463.     LG$(8) = "Locked reason read!"
  464.     LG$(9) = "Expired Registration"
  465.     END SUB
  466. '
  467. '  $SUBTITLE: 'SYSMENU - subroutine to display RBBS-PC SYSOP menu'
  468. '  $PAGE
  469. '
  470. '  SUBROUTINE NAME    --  SYSMENU
  471. '
  472. '  INPUT PARAMETERS   --  PARAMETER           MEANING
  473. '                           DELAY!    TIME IN SECONDS AFTER MIDNIGHT TO WAIT
  474. '                                     BEFORE DISPLAYING
  475. '
  476. '  OUTPUT PARAMETERS  --  NONE
  477. '
  478. '  SUBROUTINE PURPOSE --  TO DISPLAY RBBS-PC's SYSOP MENU ON THE LOCAL SCREEN
  479. '
  480.     SUB SYSMENU STATIC
  481.     DELAY! = 0
  482. 112 LOCAL.USER = TRUE
  483.     SNOOP = TRUE
  484.     NON.STOP = TRUE
  485.     SUBROUTINE.PARAMETER = 1
  486.     WHILE SUBROUTINE.PARAMETER = 1
  487.        CALL CHECKTIM (DELAY!)
  488.     WEND
  489.     CLS
  490.     STOP.INTERRUPTS = TRUE
  491.     BYPASS.TIME.CHECK = TRUE
  492.     CALL BUFFILE ("MENU0",X)
  493.     NON.STOP = FALSE
  494.     BYPASS.TIME.CHECK = FALSE
  495.     LOCAL.USER = FALSE
  496.     IF NOT OK THEN _
  497.        CALL LPRNT("MENU0 not on default drive",1)
  498.     LOCATE 2,18
  499.     CALL LPRNT(LEFT$(VERSION.ID$,8),0)
  500.     LOCATE 2,42
  501.     CALL LPRNT(NODE.ID$,0)
  502.     LOCATE 2,60
  503.     X$ = DATE$
  504.     CALL LPRNT(LEFT$(X$,6) + RIGHT$(X$,2),0)
  505.     LOCATE 2,74
  506.     CALL LPRNT(LEFT$(TIME$,5),0)
  507.     IF FMS.DIRECTORY$ <> "" THEN _
  508.        LOCATE 6,76 : _
  509.        CALL LPRNT("YES",0)
  510.     IF EXTENDED.LOGGING THEN _
  511.        LOCATE 8,76 : _
  512.        CALL LPRNT("YES",0)
  513.     IF FOSSIL THEN _
  514.        LOCATE 10,76 : _
  515.        CALL LPRNT("YES",0)
  516.     LOCATE 12,75 : _
  517.     CALL LPRNT(COM.PORT$,0)
  518.     LOCATE 14,75
  519.     CALL LPRNT (STR$(CINT(FRE("A")/1024)) + "k",0)
  520.     IF DEBUG THEN _
  521.        LOCATE 22,76 : _
  522.        CALL LPRNT("Yes",0)
  523.     END SUB
  524. '
  525. '  $SUBTITLE: 'EDITDEF - subrotuine to edit config parameters'
  526. '  $PAGE
  527. '
  528. '  SUBROUTINE NAME    -- EDITDEF
  529. '
  530. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  531. '
  532. '  OUTPUT PARAMETERS  --                          OUTPUT STRING
  533. '
  534. '  SUBROUTINE PURPOSE -- Interpretes and adjusts stored configuration
  535. '                        parameters
  536. '
  537. 120   SUB EDITDEF STATIC
  538.       ALL.OPTS$ = MAIN.COMMANDS$ + _
  539.                   FILE.COMMANDS$ + _
  540.                   UTIL.COMMANDS$ + _
  541.                   LIBRARY.COMMANDS$ + _
  542.                   GLOBAL.COMMANDS$ + _
  543.                   SYSOP.COMMANDS$
  544.       HELP.EXTENSION$ = "." + _
  545.                         HELP.EXTENSION$
  546.       BEG.MAIN = 1
  547.       BEG.FILE = LEN(MAIN.COMMANDS$) + BEG.MAIN
  548.       BEG.UTIL = LEN(FILE.COMMANDS$) + BEG.FILE
  549.       BEG.LIBRARY = LEN(UTIL.COMMANDS$) + BEG.UTIL
  550.       HELP$(3) = HELP.PATH$ + _
  551.                  HELP$(3)
  552.       HELP$(4) = HELP.PATH$ + _
  553.                  HELP$(4)
  554.       HELP$(7) = HELP.PATH$ + _
  555.                  HELP$(7)
  556.       HELP$(9) = HELP.PATH$ + _
  557.                  HELP$(9)
  558.       CALL BRKFNAME (WELCOME.FILE$,WELCOME.FILE.DRV.PATH$,PREFIX$,_
  559.                      EXTENSION$,TRUE)
  560.      CALL ASCCODES ("[","]",DEFAULT.LINE.ACK$)
  561.      CALL ASCCODES ("[","]",HOST.ECHO.ON$)
  562.      CALL ASCCODES ("[","]",HOST.ECHO.OFF$)
  563.      PERSONAL.DIR$ = PERSONAL.DRVPATH$ + _
  564.                      PERSONAL.DIR$
  565.      CALL ASCCODES ("[","]",EMPHASIZE.OFF.DEF$)
  566.      CALL ASCCODES ("[","]",EMPHASIZE.ON.DEF$)
  567.      DR.1$ = FG.1.DEF$
  568.      DR.2$ = FG.2.DEF$
  569.      DR.3$ = FG.3.DEF$
  570.      DR.4$ = FG.4.DEF$
  571.      IF SUBROUTINE.PARAMETER = -62 THEN _
  572.         EXIT SUB
  573.      ECHOER$ = DEFAULT.ECHOER$
  574.      SMART.TEXT$ = CHR$(SMART.TEXT)
  575. '
  576. ' ***  ESTABLISH RBBS-PC'S DOS SUBDIRECTORIES USAGE  ***                           *
  577. '
  578.     IF MAIN.FMS.DIRECTORY$ <> "" THEN _
  579.        FMS.DIRECTORY$ = DIRECTORY.PATH$ + _
  580.                         MAIN.FMS.DIRECTORY$ + _
  581.                         "." + _
  582.                         MAIN.DIRECTORY.EXTENTION$ : _
  583.        LIBRARY.DIRECTORY$ = LIBRARY.DIRECTORY.PATH$ + _
  584.                             MAIN.FMS.DIRECTORY$ + _
  585.                             "." + _
  586.                             LIBRARY.DIRECTORY.EXTENTION$
  587.     UPCAT.HELP$ = HELP.PATH$ + _
  588.                   UPCAT.HELP$ + _
  589.                   HELP.EXTENSION$
  590.     IF SUBDIR.COUNT < 1 THEN _
  591.        GOTO 123
  592.     FOR SUBDIR.INDEX = 1 TO SUBDIR.COUNT
  593.        INPUT #2,SUBDIR$
  594.        IF RIGHT$(SUBDIR$,1) <> "\" THEN _
  595.          SUBDIR$(SUBDIR.INDEX) = SUBDIR$ + _
  596.                                  "\" _
  597.        ELSE SUBDIR$(SUBDIR.INDEX) = SUBDIR$
  598.     NEXT
  599.     GOTO 125
  600. 123 FOR SUBDIR.INDEX = 1 TO LEN(DOWNLOAD.DRIVES$) - 1
  601.        SUBDIR$(SUBDIR.INDEX) = MID$(DOWNLOAD.DRIVES$,SUBDIR.INDEX,1) + _
  602.                                ":"
  603.     NEXT
  604.     SUBDIR.COUNT = LEN(DOWNLOAD.DRIVES$) - 1
  605. '
  606. ' *****  SETUP UPLOAD DRIVE AND DIRECTORY.NAME  ****
  607. '
  608. 125 UPLOAD.DIR.CHECK$ = UPLOAD.DIRECTORY$
  609.     SUBDIR.COUNT = SUBDIR.COUNT + 1
  610.     IF UPLOAD.TO.SUBDIR THEN _
  611.        SUBDIR$(SUBDIR.COUNT) = UPLOAD.SUBDIR$ + _
  612.                                "\" _
  613.     ELSE SUBDIR$(SUBDIR.COUNT) = RIGHT$(DOWNLOAD.DRIVES$,1) + _
  614.                                  ":"
  615.     UPLOAD.DIRECTORY$ = UPLOAD.DIRECTORY$ + _
  616.                         "." + _
  617.                         MAIN.DIRECTORY.EXTENTION$
  618.     CALL CHKNARY (SUBDIR$(SUBDIR.COUNT),SUBDIR$(),SUBDIR.COUNT-1,FOUND)
  619.     CAN.DOWNLOAD.FROM.UP = (FOUND > 0)
  620.     UPLOAD.DIRECTORY$ = UPLOAD.PATH$ + _
  621.                         UPLOAD.DIRECTORY$
  622. 126 CLOSE #2
  623.     IF LIBRARY.DRIVE$ <> "" THEN _
  624.        LIBRARY.TYPE = 1
  625.     SUBROUTINE.PARAMETER = -10
  626.     CALL CARRIER
  627.     IF SUBROUTINE.PARAMETER = -1 THEN _
  628.        IF LIBRARY.DRIVE$ <> "" THEN _
  629.           CALL CHANGEDIR (LIBRARY.DRIVE$ + _
  630.                          "\") : _
  631.           CALL KILLWORK (LIBRARY.WORK.DISK.PATH$ + _
  632.                         LIBRARY.NODE.ID$ + _
  633.                         "DK*.ARC") : _
  634.                         EC = 0
  635. '
  636. ' ***  INITIALIZE OMNINET INTERFACE IF OMNINET IN USE  ***                         *
  637. '
  638. 128 IF NETWORK.TYPE = 2 THEN _
  639.        CN$ = SPACE$(535) : _
  640.        CALL INITIO(A)
  641.        END SUB
  642. '
  643. '  $SUBTITLE: 'ASCCODES - subrotuine to allow any ASCII codes'
  644. '  $PAGE
  645. '
  646. '  SUBROUTINE NAME    -- ASCCODES
  647. '
  648. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  649. '                           LEFT.PAREN$           MARKS BEGINNING OF #
  650. '                           RIGHT.PAREN$          MARKS END OF #
  651. '                           STRNG$                INPUT STRING
  652. '
  653. '  OUTPUT PARAMETERS  --    STRNG$                OUTPUT STRING
  654. '
  655. '  SUBROUTINE PURPOSE -- TO ALLOW A CONFIG STRING TO HAVE ANY ASCII VALUES.
  656. '                        CHARACTERS NOT ENCLOSED TAKEN AS IS.  ENCLOSED
  657. '                        CHARACTERS INTERPRETED AS VALUE OF ASCII CODE.
  658. '                        (I.E. "123[32]4" IS INTERPRETED AS "123 4").
  659. '
  660. 129 SUB ASCCODES (LEFT.PAREN$,RIGHT.PAREN$,STRNG$) STATIC
  661.     IF LEN(STRNG$) < 1 THEN _
  662.        EXIT SUB
  663.     STRT = 1
  664.     L = LEN(STRNG$)
  665.     B$ = STRNG$ + _
  666.          LEFT.PAREN$
  667.     X = INSTR(B$,LEFT.PAREN$)
  668.     NEW.STRNG$ = ""
  669.     WHILE STRT <= L
  670.        NEW.STRNG$ = NEW.STRNG$ + _
  671.                     MID$(B$,STRT,X - STRT)
  672.        Y = INSTR(X,B$,RIGHT.PAREN$)
  673.        IF Y > 0 THEN _
  674.           K = VAL(MID$(B$,X + 1,Y - X - 1)) : _
  675.           NEW.STRNG$ = NEW.STRNG$ + _
  676.                        CHR$(K) : _
  677.           STRT = Y + 1 _
  678.        ELSE NEW.STRNG$ = NEW.STRNG$ + _
  679.                          MID$(B$,X,L + 1 - X) : _
  680.             STRT = L + 1
  681.        X = INSTR(STRT,B$,LEFT.PAREN$)
  682.     WEND
  683.     STRNG$ = NEW.STRNG$
  684.     END SUB
  685. ' $SUBTITLE: 'ANSWERIT - subroutine to answer the phone when it rings'
  686. ' $PAGE
  687. '
  688. '  SUBROUTINE NAME    -- ANSWERIT
  689. '
  690. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  691. '                       SUBROUTINE.PARAMETER = 1   WAIT FOR PHONE TO RING
  692. '                       SUBROUTINE.PARAMETER = 2   CONTINUE LOOKING FOR CONNECT
  693. '                       SUBROUTINE.PARAMETER = 3   RENTRY AFTER FUNCTION KEY
  694. '                       SUBROUTINE.PARAMETER = 4   GO ON LINE IMMEDIATELY
  695. '                       BG                         LOCAL DISPLAY'S BACKGROUND
  696. '                       BORDER                     LOCAL DISPLAY'S BORDER COLOR
  697. '                       COM.PORT$                  COMMUNICATIONS PORT NAME
  698. '                       COMPUTER.TYPE              TYPE OF COMPUTER RUNNING ON
  699. '                       DUMB.MODEM                 NON-HAYES TYPE MODEM FLAG
  700. '                       EXTENDED.LOGGING           EXTENDED CALLERS LOG FLAG
  701. '                       FG                         LOCAL DISPLAY'S FOREGROUND
  702. '                       MODEM.ANSWER.COMMAND$      COMMAND TO ANSWER PHONE
  703. '                       MODEM.CONTROL.REGISTER     LOCATION OF MODEM CNTRL. REG
  704. '                       MODEM.COUNT.RINGS.COMMAND$ COMMAND TO COUNT PHONE RINGS
  705. '                       MODEM.INIT.BAUD$           BAUDE AT WHICH TO OPEN COMM.
  706. '                       MODEM.RESET.COMMAND$       COMMAND TO RESET THE MODEM
  707. '                       MODEM.STATUS.REGISTER      LOCATION OF MODEM STATUS REG
  708. '                       PRINTER                    FLAG TO PRINT ON LOCAL PRT.
  709. '                       REQUIRED.RINGS             NUMBER OF RINGS TO ANSWER ON
  710. '                       SNOOP                      FLAG TO DISPLAY ON LOCAL PC
  711. '                       SYSOP.NEXT                 FLAG TO GIVE SYSOP CONTROL
  712. '
  713. '  OUTPUT PARAMETERS -- BAUD.TEST                  BAUD RATE TO SET RS232 AT
  714. '                       EIGHT.BIT                  PARITY INDICATOR
  715. '                       RELIABLE.MODE              INDICATES MODEM-SUPPLIED
  716. '                                                  "ERROR-FREE" PROTOCOL ACTIVE
  717. '                       SUBROUTINE.PARAMETER = 1   CARRIER DETECT FOUND (I.E.
  718. '                                                  MODEM AUTO-ANSWERED).
  719. '                                            = 2   ANSWERED THE PHONE AND
  720. '                                                  CARRIER DETECT OCCURRED.
  721. '                                            = 3   SYSOP HIT "ESC" KEY ON THE
  722. '                                                  LOCAL KEYBOARD.
  723. '                                            = 4   ANSWERED THE PHONE BUT NO
  724. '                                                  CARRIER WAS DETECTED.
  725. '                                            = 5   COMM. BUFFER OVERFLOW.
  726. '                                            = 6   FUNCTION KEY PRESSED ON THE
  727. '                                                  LOCAL KEYBOARD.
  728. '
  729. '  SUBROUTINE PURPOSE -- TO ANSWER THE TELEPHONE WHEN IT RINGS.
  730. '
  731.       SUB ANSWERIT STATIC
  732.       EC = 0
  733.       RELIABLE.MODE = FALSE
  734.       FF = SUBROUTINE.PARAMETER
  735.       SUBROUTINE.PARAMETER = 0
  736.       ON FF GOTO 201,324,245,320
  737. '
  738. ' *
  739. ' *  INITIALIZE MODEM AND ANNOUNCE RBBS-PC IS UP AND READY FOR CALLS          *
  740. ' *
  741. '
  742. 201 SUBROUTINE.PARAMETER = -10
  743.     CALL CARRIER
  744.     IF SUBROUTINE.PARAMETER = 0 THEN _
  745.        GOTO 210
  746.     EXIT.TO.DOORS = FALSE
  747.     PRIVATE.DOOR = FALSE
  748. '
  749. ' *
  750. ' *  RESET THE MODEM VIA THE MODEM CONTROL REGISTER  TO ASSURE IT IS READY    *
  751. ' *
  752. '
  753.     IF FOSSIL THEN _
  754.        STATE% = 0 : _
  755.        CALL FOSDTR(COMPORT%,STATE%) _
  756.     ELSE OUT MODEM.CONTROL.REGISTER,&H4
  757.     CALL DELAYIT (MODEM.INIT.WAIT.TIME)
  758. '
  759. ' *
  760. ' *  CLEAR THE MODEM CONTROL REGISTER PRIOR TO OPEN THE COMMUNICATIONS PORT   *
  761. ' *
  762. '
  763.     IF FOSSIL THEN _
  764.        STATE% = 1 : _
  765.        CALL FOSDTR(COMPORT%,STATE%) _
  766.     ELSE OUT MODEM.CONTROL.REGISTER,&H0
  767.     CALL DELAYIT (MODEM.INIT.WAIT.TIME)
  768. 210 IF PRIVATE.DOOR THEN _
  769.        CALL TRANSFER : _
  770.        GOTO 235
  771.     CALL OPENCOM(MODEM.INIT.BAUD$,",N,8,1")
  772. 220 SUBROUTINE.PARAMETER = 1
  773.     CALL AMORPM
  774. 230 IF PRINTER THEN _
  775.        CALL PRINTIT (" RBBS-PC " + VERSION.ID$ + " Node " + _
  776.                     NODE.ID$ + " up " + TIM$ + " on " + DATE$)
  777. 235 EIGHT.BIT = TRUE
  778.     SUBROUTINE.PARAMETER = -10
  779.     CALL CARRIER
  780.     IF SUBROUTINE.PARAMETER = 0 AND _
  781.        EXIT.TO.DOORS THEN _
  782.        CALL READPROF : _
  783.        SUBROUTINE.PARAMETER = 1 : _
  784.        GOTO 335
  785.     IF SUBROUTINE.PARAMETER = 0 AND _
  786.        EXPECT.ACTIVE.MODEM THEN _
  787.        BAUD.TEST = VAL(NETBAUD$) : _
  788.        CALL TESTREL (NETRELIABLE$) : _
  789.        GOTO 328
  790.     IF EXPECT.ACTIVE.MODEM OR _
  791.        EXIT.TO.DOORS THEN _
  792.        SUBROUTINE.PARAMETER = 4 : _
  793.        EXIT SUB
  794.     IF SUBROUTINE.PARAMETER = 0 THEN _
  795.        GOTO 324
  796.     PCJR = FALSE
  797.     IF COMPUTER.TYPE = 2 AND _
  798.        COM.PORT$ = "COM1" AND _
  799.        MODEM.STATUS.REGISTER = 1022 THEN _
  800.        MODEM.GO.OFFHOOK.COMMAND$ = CHR$(14) + _
  801.                                    "P" : _
  802.        PCJR = TRUE
  803.     CALL SYSMENU
  804.     IF PCJR THEN _
  805.        A$ = CHR$(14) + _
  806.             "I" _
  807.     ELSE A$ = MODEM.RESET.COMMAND$
  808.     CALL MODEMPUT (A$)
  809.     CALL DELAYIT (MODEM.INIT.WAIT.TIME)
  810.     IF PCJR THEN _
  811.        A$ = CHR$(14) + _   ' PC-JR'S MODEM COMMAND IDENTIFIER
  812.               "C 0," + _   ' SET "AUTO-ANSWER" OFF ON PC-JR'S MODEM
  813.               "S 1," + _   ' SET SPEED TO 300 BAUD ON PC-JR'S MODEM
  814.               "H" _        ' MANUALLY HANG UP THE PHONE (IF NOT ALREADY)
  815.     ELSE A$ = MODEM.INIT.COMMAND$
  816.     CALL MODEMPUT (A$)
  817.     IF PCJR THEN _
  818.        A$ = CHR$(14) + _
  819.             "F 4" : _
  820.        CALL MODEMPUT (A$)
  821.     RINGBACK = FALSE
  822.     LOCATE 16,55
  823.     IF REQUIRED.RINGS = 0 THEN _
  824.        CALL LPRNT("WAITING FOR CARRIER",0) : _
  825.        GOTO 237
  826.     IF MID$(MODEM.INIT.COMMAND$, _
  827.           INSTR(MODEM.INIT.COMMAND$,"S0") + 3,3) = "255" THEN _
  828.        CALL LPRNT("RING BACK SYSTEM",0) : _
  829.        RINGBACK = TRUE : _
  830.        GOTO 236
  831.     CALL LPRNT("WAITING FOR RING ",0)
  832. 236 LOCATE 16,76 : _
  833.     CALL LPRNT(MID$(STR$(REQUIRED.RINGS),2),0)
  834. 237 LOCATE 18,76
  835.     IF DOSANSI THEN _
  836.        CALL LPRNT(ESCAPE$ + "[05m" + "YES" + ESCAPE$ + "[00m",0) _
  837.     ELSE CALL LPRNT ("YES",0)
  838.     COLOR FG,BG,BORDER
  839.     LOCATE 20,56
  840. '
  841. ' *
  842. ' *  GET READY TO ANSWER INCOMMING CALL:                                      *
  843. ' *       1.  LET THE MODEM "AUTO-ANSWER" FOR RBBS-PC.                        *
  844. ' *           REQUIRED RINGS = 0 AND S0 = 1 IN MODEM INIT COMMAND.            *
  845. ' *       2.  ANSWER THE MODEM ON A SPECIFIED NUMBER OF RINGS.                *
  846. ' *           REQUIRED RINGS > 0 AND S0 = 254 IN MODEM INIT COMMAND.          *
  847. ' *       3.  ANSWER THE MODEM ON A SPECIFIED NUMBER OF RINGS AFTER A USER    *
  848. ' *           FIRST CALLS AND THEN HANGS UP (I.E. RING-BACK).                 *
  849. ' *           REQUIRED RINGS > 0 AND S0 = 255 IN MODEM INIT COMMAND.          *
  850. ' *
  851. '
  852.     QQ = 255
  853.     I = INSTR(MODEM.INIT.COMMAND$,"S0")
  854.     IF I = 0 OR PCJR THEN _
  855.        GOTO 239
  856.     IF VAL(MID$(MODEM.INIT.COMMAND$,I + 3,3)) = 255 THEN _
  857.        QQ = 0 : _
  858.        BLK = QQ
  859.     CALL FINDTIME (TCA!)
  860.     SUBROUTINE.PARAMETER = 1
  861.     CALL LINE25
  862.     RING.ANSWER = TRUE
  863.     IF RINGBACK THEN _
  864.        RING.ANSWER = FALSE
  865. 239 RINGBACK.WAIT.STARTED! = 0
  866.     IF RINGBACK THEN _
  867.        CALL FINDTIME (RINGBACK.WAIT.STARTED!) : _
  868.        COLOR 7,0,0 _
  869.     ELSE COLOR FG,BG,BORDER
  870. 240 IF SYSOP.NEXT THEN _
  871.        SUBROUTINE.PARAMETER = 3 : _
  872.        EXIT SUB
  873. '
  874. ' *
  875. ' * WAIT FOR INCOMING CALLS                                                   *
  876. ' *
  877. '
  878.     SCREEN.ALREADY.CLEARED = FALSE
  879. 245 CALL SETABORT (INACTIVE.DELAY!, (60 * RECYCLE.WAIT))
  880.     NO.CALL = TRUE
  881.     CALL FLUSHCOM (MODEM.RESPONSE$)
  882.     MODEM.RESPONSE$ = ""
  883.     WHILE INP(MODEM.STATUS.REGISTER) < 128 AND NO.CALL
  884.        CALL FINDFUNC
  885.        IF SUBROUTINE.PARAMETER < 0 THEN _
  886.           EXIT SUB
  887. 250    IF KEY.PRESSED$ = ESCAPE$ THEN _
  888.           SUBROUTINE.PARAMETER = 3 : _
  889.           EXIT SUB
  890. 260    IF RINGBACK.WAIT.STARTED! > 0 THEN _
  891.           CALL FINDTIME (TI!) : _
  892.        IF ABS(TI! - RINGBACK.WAIT.STARTED!) > 45 THEN _
  893.           RINGBACK.WAIT.STARTED! = 0 : _
  894.           RING.BACK.COUNT = 0 : _
  895.           RING.ANSWER = FALSE: _
  896.           IF RINGBACK THEN _
  897.             LOCATE 20,56 : _
  898.             CALL LPRNT("Ringback timeout" + PAGING.PRINTER.SUPPORT$,1)
  899. 265    CALL FINDTIME (TI!)
  900.        IF ABS(TI! - TCA!) > 120 AND NOT SCREEN.ALREADY.CLEARED THEN _
  901.           LOCATE ,,0 : _
  902.           CLS : _
  903.           C.L = 1 : _
  904.           SCREEN.ALREADY.CLEARED = TRUE : _
  905.           CALL FINDTIME (TCA!)
  906.        IF TIME.TO.DROP.TO.DOS! > 0 AND _
  907.           OLD.DAT$ <> DATE$ AND _
  908.           TI! < 86340 AND _        ' Skip btw 23:59 and 00:00
  909.           TI! => TIME.TO.DROP.TO.DOS! THEN _
  910.              SUBROUTINE.PARAMETER = 7 : _
  911.              EXIT SUB
  912. 266    IF (INP(MODEM.STATUS.REGISTER) AND &H40) > 0 AND _
  913.           REQUIRED.RINGS > 0 THEN _
  914.           GOTO 276
  915. 270    IF RECYCLE.WAIT > 0 THEN _
  916.           IF TI! > INACTIVE.DELAY! THEN _
  917.              SUBROUTINE.PARAMETER = 8 : _
  918.              EXIT SUB
  919.        CALL FLUSHCOM (X$)
  920.        IF LEN(X$) > 0 THEN _
  921.           MODEM.RESPONSE$ = MODEM.RESPONSE$ + X$ : _
  922.           RING.DETECTED = (INSTR(MODEM.RESPONSE$,"RING") > 0) : _
  923.           CONNECT.DETECTED = (INSTR(MODEM.RESPONSE$,"ONNECT") > 0) : _
  924.           NO.CALL = (NOT RING.DETECTED) AND (NOT CONNECT.DETECTED)
  925.     IF RING.DETECTED AND REQUIRED.RINGS > 0 THEN _
  926.        MID$(MODEM.RESPONSE$, INSTR(MODEM.RESPONSE$,"RING")+1,1) = "A" : _
  927.        RING.DETECTED = FALSE : _
  928.        GOTO 276
  929.     CALL GOIDLE
  930.     WEND
  931.     IF NOT RINGBACK THEN _
  932.        IF CONNECT.DETECTED THEN _
  933.           GOTO 321
  934.     IF REQUIRED.RINGS = 0 THEN _
  935.        CALL DELAYIT (3) : _
  936.        GOTO 321
  937. '
  938. ' *
  939. ' * PREPARE TO ANSWER THIS CALL ON A SPECIFIED NUMBER OF RINGS (S0 = 254) OR  *
  940. ' * THE CALL AFTER THIS CALL ON A SPECIFIED NUMBER OF RINGS (S0 = 255) --     *
  941. ' * "RING BACK."                                                              *
  942. ' *
  943. '
  944. 276 CALL EOFCOMM (CHAR%)
  945.     IF CHAR% <> -1 THEN _
  946.        CALL FLUSHCOM(X$) : _
  947.        IF SUBROUTINE.PARAMETER = - 1 THEN _
  948.           EXIT SUB
  949.     IF PCJR THEN _
  950.        GOTO 320
  951.     A$ = MODEM.COUNT.RINGS.COMMAND$
  952.     CALL MODEMPUT (A$)
  953.     CALL DELAYIT (MODEM.COMMAND.DELAY.TIME)
  954. 290 CALL FLUSHCOM(X$)
  955.     IF SUBROUTINE.PARAMETER = -1 THEN _
  956.        EXIT SUB
  957. 291 IF LEN(X$) = 0 THEN _
  958.        GOTO 310
  959. 292 IF INSTR(X$,"0") < 1 THEN _
  960.        GOTO 293
  961.     X$ = MID$(X$,INSTR(X$,"0"))
  962. 293 IF (NOT RING.ANSWER) AND (VAL(X$) < RING.BACK.COUNT) THEN _
  963.        RING.ANSWER = TRUE
  964. 300 RING.BACK.COUNT = VAL(X$)
  965.     Q = RING.BACK.COUNT + 1
  966.     IF (NOT RING.ANSWER) THEN _
  967.        Q = 0
  968. 305 LOCATE 20,56
  969.     CALL LPRNT(TIME$ + " Ring " + STR$(Q),0)
  970. 310 IF (RING.BACK.COUNT + 1 < REQUIRED.RINGS) OR _
  971.        (NOT RING.ANSWER) THEN _
  972.        GOTO 239
  973. 320 IF PCJR THEN _
  974.        A$ = CHR$(14) + _   ' PC-JR'S MODEM COMMAND IDENTIFIER
  975.             "T 0," + _     ' SET PC-JR'S MODEM TO TRANSPARENT MODE PERMANENTLY
  976.             "M" _          ' TELL THE PC-JR'S MODEM TO ANSWER IN DATA MODE
  977.     ELSE A$ = MODEM.ANSWER.COMMAND$
  978.     CALL MODEMPUT (A$)
  979. '
  980. ' *
  981. ' *  TEST FOR CARRIER PRESENT                                                 *
  982. ' *
  983. '
  984. 321 CALL SETABORT (CONNECT.DELAY!,MAX.CARRIER.WAIT)
  985.     IF CONNECT.DELAY! > 86399 THEN _
  986.        CONNECT.DELAY! = 86399
  987. 322 CALL FINDTIME (TI!)
  988. 323 SUBROUTINE.PARAMETER = -10
  989.     CALL CARRIER
  990.     IF SUBROUTINE.PARAMETER AND _
  991.        TI! < CONNECT.DELAY! THEN _
  992.        GOTO 322
  993.     IF SUBROUTINE.PARAMETER THEN _
  994.        SUBROUTINE.PARAMETER = 4 : _
  995.        EXIT SUB
  996.     CALL DELAYIT (3)
  997. 324 SUBROUTINE.PARAMETER = 0
  998.     IF TI! > CONNECT.DELAY! THEN _
  999.        CALL UPDTCALR ("Connect timeout",1) : _
  1000.        SUBROUTINE.PARAMETER = 4 : _
  1001.        EXIT SUB
  1002. 325 CALL FLUSHCOM(X$)
  1003.     IF SUBROUTINE.PARAMETER = -1 THEN _
  1004.        IF EC = 69 THEN _
  1005.           SUBROUTINE.PARAMETER = 5 : _
  1006.        EXIT SUB
  1007.     MODEM.RESPONSE$ = MODEM.RESPONSE$ + X$
  1008.     CALL FINDTIME (TI!)
  1009.     IF TI! > CONNECT.DELAY! THEN _
  1010.        CALL UPDTCALR ("Connect timeout",1) : _
  1011.        SUBROUTINE.PARAMETER = 4 : _
  1012.        EXIT SUB
  1013.     IF DUMB.MODEM THEN _
  1014.        BAUD.TEST = VAL(MODEM.INIT.BAUD$) : _
  1015.        GOTO 327
  1016.     IF INSTR(MODEM.RESPONSE$,"FAST") THEN _
  1017.        BAUD.TEST = 19200 : _
  1018.        GOTO 327
  1019.     IF INSTR(MODEM.RESPONSE$,"ONNECT") THEN _
  1020.        BAUD.TEST = VAL(MID$(MODEM.RESPONSE$,INSTR(MODEM.RESPONSE$,"ONNECT") + 7)) : _
  1021.        GOTO 327
  1022.     IF INSTR(MODEM.RESPONSE$,"ONLINE") THEN _
  1023.        BAUD.TEST = VAL(MID$(MODEM.RESPONSE$,INSTR(MODEM.RESPONSE$,"ONLINE") + 7)) : _
  1024.        GOTO 327
  1025.     GOTO 324
  1026. 327 CALL TESTREL (MODEM.RESPONSE$)
  1027. 328 IF BAUD.TEST = 0 OR BAUD.TEST = 300 THEN _
  1028.        BAUD.TEST = 300 : _
  1029.        BPS = -1 : _
  1030.        GOTO 331
  1031.     IF BAUD.TEST = 1200 OR BAUD.TEST = 1275 THEN _
  1032.        BPS = -3 : _
  1033.        GOTO 331
  1034.     IF BAUD.TEST = 2400 THEN _
  1035.        BPS = -4 : _
  1036.        GOTO 331
  1037.     IF BAUD.TEST = 4800 OR BAUD.TEST = 9600 THEN _
  1038.        BPS = -4-(BAUD.TEST /4800) : _
  1039.        GOTO 331
  1040.     IF BAUD.TEST = 19200 THEN _
  1041.        BPS = -7 : _
  1042.        GOTO 331
  1043.     GOTO 324
  1044. 331 CALL SETBAUD
  1045.     SUBROUTINE.PARAMETER = 2
  1046. 335 DONT.WRITE = 0
  1047.     END SUB
  1048. ' $SUBTITLE: 'TESTREL - Test for Reliable mode connection'
  1049. ' $PAGE
  1050. '
  1051. '  SUBROUTINE NAME    -- TESTREL
  1052. '
  1053. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1054. '                           STRNG$                 String to check for reliable
  1055. '
  1056. '  OUTPUT PARAMETERS  --    RELIABLE.MODE          Reliable mode indicator
  1057. '
  1058. '  SUBROUTINE PURPOSE -- TO TEST FOR RELIABLE CONNECT
  1059. '
  1060. 336 SUB TESTREL (STRNG$) STATIC
  1061.     RELIABLE.MODE = FALSE
  1062.     IF STRNG$ = "" THEN _
  1063.        EXIT SUB
  1064.     IF INSTR(STRNG$,"REL") OR _
  1065.        INSTR(STRNG$,"R C") OR _       (ERROR CONTROL)
  1066.        INSTR(STRNG$,"ARQ") OR _
  1067.        INSTR(STRNG$,"LAP") OR _
  1068.        INSTR(STRNG$,"AFT") OR _
  1069.        INSTR(STRNG$,"MNP") THEN _
  1070.          RELIABLE.MODE = -1
  1071.     END SUB
  1072. ' $SUBTITLE: 'BADCHAR - subroutine to check user names for bad characters'
  1073. ' $PAGE
  1074. '
  1075. '  SUBROUTINE NAME    -- BADCHAR
  1076. '
  1077. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1078. '                           PASSED.NAME$           USER NAME
  1079. '
  1080. '  OUTPUT PARAMETERS  --    PASSED.NAME$           USER NAME WILL CONTAIN ""
  1081. '                                                  IF BAD CHARACTERS FOUND
  1082. '
  1083. '  SUBROUTINE PURPOSE -- TO CHECK USER NAMES FOR INVALID CHARACTERS
  1084. '
  1085.     SUB BADCHAR (PASSED.NAME$) STATIC
  1086.     J = 1
  1087.     XX = LEN(PASSED.NAME$)
  1088. 457 IF J > XX THEN _
  1089.        EXIT SUB
  1090.     X$ = MID$(PASSED.NAME$,J,1)
  1091.     IF INSTR("ABCDEFGHIJKLMNOPQRSTUVWXYZ '-./0123456789",X$) = 0 THEN _
  1092.        PASSED.NAME$ = "" : _
  1093.        EXIT SUB
  1094.     J = J + 1
  1095.     GOTO 457
  1096.     END SUB
  1097. ' $SUBTITLE: 'PASSWRD - verify User and Message passwords'
  1098. ' $PAGE
  1099. '
  1100. '  SUBROUTINE NAME    -- PASSWRD
  1101. '
  1102. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1103. '                        SUBROUTINE.PARAMETER = 1  VERIFY USER PASSWORD
  1104. '                        SUBROUTINE.PARAMETER = 2  VERIFY MESSAGE PASSWORD
  1105. '                        SUBROUTINE.PARAMETER = 3  VERIFY MESSAGE PASSWORD
  1106. '                        SUBROUTINE.PARAMETER = 4  VERIFY MESSAGE PASSWORD
  1107. '                        SUBROUTINE.PARAMETER = 5  VERIFY MESSAGE PASSWORD
  1108. '
  1109. '  OUTPUT PARAMETERS  -- PASSWORD.FAILED           SET TO 0 IF PASSED
  1110. '                                                  SET TO -1 IF FAILED
  1111. '
  1112. '  SUBROUTINE PURPOSE -- TO VERIFY USER AND MESSAGE PASSWORDS
  1113. '
  1114.     SUB PASSWRD STATIC
  1115.     EC = 0
  1116.     ON SUBROUTINE.PARAMETER GOTO 665,667,670,675,677
  1117. 665 IF PASSWORD.SAVE$ = PASSWORD$ THEN _
  1118.        PASSWORD.FAILED = 0 : _
  1119.        EXIT SUB
  1120. 667 ATTEMPTS = 0
  1121. 670 ATTEMPTS = ATTEMPTS + 1
  1122.     IF ATTEMPTS > ATTEMPTS.ALLOWED THEN _
  1123.        PASSWORD.FAILED = TRUE : _
  1124.        EXIT SUB
  1125. 675 A$ = "Enter Password (dots echo)"
  1126.     HIDDEN = TRUE
  1127.     SUBROUTINE.PARAMETER = 1
  1128.     CALL TGET
  1129.     HIDDEN = FALSE
  1130.     Z$ = B$
  1131. 677 IF LEN(Z$) > 15 THEN _
  1132.        GOTO 680
  1133.     IF EC <> 0 THEN _
  1134.        GOTO 670
  1135.     CALL ALLCAPS (Z$)
  1136.     Z$ = Z$ + SPACE$(15 - LEN(Z$))
  1137.     IF PASSWORD.SAVE$ = Z$ THEN _
  1138.        PASSWORD.FAILED = 0 : _
  1139.        EXIT SUB
  1140. 680 CALL QTPUT("Wrong password ",1)
  1141.     IF NOT MESSAGE.PASSWORD THEN _
  1142.        CALL UPDTCALR (ACTIVE.USER.NAME$+" PW fail: " + Z$,1)
  1143.     GOTO 670
  1144.     END SUB
  1145. ' $SUBTITLE: 'LINE25 - subroutine to build/display RBBS-PCs line 25'
  1146. ' $PAGE
  1147. '
  1148. '  SUBROUTINE NAME    -- LINE25
  1149. '
  1150. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1151. '                        SUBROUTINE.PARAMETER = 1  BUILD DISPLAY FOR LINE 25
  1152. '                        SUBROUTINE.PARAMETER = 2  UPDATE LINE 25
  1153. '                        LOCK.STATUS$              STATUS OF LOCKS IN A MULTI-
  1154. '                                                  USER ENVIRONMENT OR TIME OF
  1155. '                                                  DAY USER LOGGED ON OR THE
  1156. '                                                  RE-CYCLED
  1157. '
  1158. '  OUTPUT PARAMETERS  -- CURSOR.LINE               CURRENT LINE ON SCREEN
  1159. '                        CURSOR.ROW                CURRENT ROW ON CURSOR.LINE
  1160. '
  1161. '  SUBROUTINE PURPOSE -- TO BUILD OR UPDATE RBBS-PC'S LINE 25 DISPLAYED
  1162. '                        ON THE PC SCREEN THAT IS RUNNING RBBS-PC.
  1163. '
  1164.       SUB LINE25 STATIC
  1165.       IF SUBROUTINE.PARAMETER = 2 THEN _
  1166.          GOTO 950
  1167. '
  1168. ' *
  1169. ' *  BUILD LINE 25 DISPLAY                                                    *
  1170. ' *
  1171. '
  1172. 949 LINE.25$ = "Node " + _
  1173.                NODE.ID$ + " " + _
  1174.                PAGE.STATUS$ + " " + _
  1175.                MID$("    AVL ",1 - 4 * SYSOP.AVAILABLE,4) + _
  1176.                MID$("    ANY ",1 - 4 * SYSOP.ANNOY,4) + _
  1177.                MID$("    LPT ",1 - 4 * PRINTER,4) + _
  1178.                MID$("SYS",1,-3 * SYSOP.NEXT) + _
  1179.                MID$(" XOFF",1,-5 * XOFF.ED) + _
  1180.                MID$(" CTS",1,-4 * NOT.CTS)
  1181. '
  1182. ' *
  1183. ' *  LINE 25 UPDATE ROUTINE                                                   *
  1184. ' *
  1185. '
  1186. 950 IF NOT SNOOP THEN _
  1187.        EXIT SUB
  1188.     CURSOR.LINE = CSRLIN
  1189.     CURSOR.ROW = POS(0)
  1190.     HH = LEN(ACTIVE.USER.NAME$) + _
  1191.          LEN(CI$) + _
  1192.          LEN(LINE.25$) + _
  1193.          LEN(STR$(USER.SECURITY.LEVEL)) + _
  1194.          18
  1195.     IF AUTODOWNLOAD.AVAILABLE THEN _
  1196.        HH = HH + 4
  1197.     LOCATE 25,1
  1198.     IF NETWORK.TYPE = 0 THEN _
  1199.        IF AUTODOWNLOAD.AVAILABLE THEN _
  1200.           LOCK.STATUS$ = SPACE$(3) + _
  1201.                          "AD  " + _
  1202.                          TIME.LOGGED.ON$ _
  1203.        ELSE LOCK.STATUS$ = SPACE$(3) + _
  1204.                            TIME.LOGGED.ON$
  1205.     IF HH > 79 THEN _
  1206.        HH = 78
  1207.     LINE.25.HOLD$ = LINE.25$ + _
  1208.                     SPACE$(79 - HH) + _
  1209.                     STR$(USER.SECURITY.LEVEL) + _
  1210.                     " " + _
  1211.                     ACTIVE.USER.NAME$ + _
  1212.                     " " + _
  1213.                     CI$ + _
  1214.                     " " + _
  1215.                     LOCK.STATUS$
  1216.     CALL LPRNT(LINE.25.HOLD$,0)
  1217.     LOCATE CURSOR.LINE,CURSOR.ROW
  1218.     END SUB
  1219. ' $SUBTITLE: 'SRCHCMND    - subroutine to search command list'
  1220. ' $PAGE
  1221. '
  1222. '  SUBROUTINE NAME    -- SRCHCMND
  1223. '
  1224. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  1225. '                        STRT.POS      POSITION TO BEGIN SEARCH AT
  1226. '                        ALL.OPTS$     STRING TO SEARCH (COMMAND LIST)
  1227. '                        Z$            WHAT TO LOOK FOR
  1228. '
  1229. '  OUTPUT PARAMETERS  -- WHERE.FOUND   POSITION OF Z$ IN ALL.OPTS$
  1230. '                                      0 IF NOT FOUND
  1231. '
  1232. '  SUBROUTINE PURPOSE -- SEARCHES VALID COMMAND LIST FOR THE REQUESTED
  1233. '                        COMMAND.  IF THE SYSOP HAS CONFIGURED RBBS-PC TO
  1234. '                        RESTRICT COMMANDS TO ONLY THOSE VALID WITHIN THE
  1235. '                        RBBS-PC SUBSYSTEM, THEN ONLY THOSE COMMANDS AND
  1236. '                        "GLOBAL" COMMANDS ARE VALID.  OTHERWISE ALL COMMANDS
  1237. '                        ARE VALID FROM ANY OF THE RBBS-PC SUBSYSTEMS.
  1238. '
  1239.      SUB SRCHCMND (STRT.POS,WHERE.FOUND) STATIC
  1240. 1240 IF LEN(Z$) < 1 THEN _
  1241.         WHERE.FOUND = 0 : _
  1242.         EXIT SUB
  1243.      Y$ = LEFT$(Z$,1)
  1244.      WHERE.FOUND = INSTR(STRT.POS,ALL.OPTS$,Y$)
  1245.      IF WHERE.FOUND = 0 THEN _  'Not found: decide whether to hunt further
  1246.         IF STRT.POS < 2 OR RESTRICT.VALID.CMDS THEN _
  1247.            GOTO 1242 _  ' fully searched or restricted
  1248.         ELSE WHERE.FOUND = INSTR(1,ALL.OPTS$,Y$) : _ 'hunt further
  1249.              GOTO 1242
  1250.      IF WHERE.FOUND => BEG.LIBRARY THEN _
  1251.         IF WHERE.FOUND < LEN(ALL.OPTS$) - 11 THEN _
  1252.            IF LIBRARY.TYPE = 0 THEN _
  1253.               WHERE.FOUND = INSTR(WHERE.FOUND+1,ALL.OPT$,Y$) : _
  1254.               IF WHERE.FOUND = 0 THEN _
  1255.                  WHERE.FOUND = INSTR(1,ALL.OPTS$,Y$) : _
  1256.                  IF WHERE.FOUND >= BEG.LIBRARY OR WHERE.FOUND = 0 THEN _
  1257.                     WHERE.FOUND = 0 : _
  1258.                     GOTO 1242
  1259.      IF NOT RESTRICT.VALID.CMDS THEN _
  1260.         GOTO 1242            ' everything found valid
  1261. '
  1262. ' *
  1263. ' * RESTRICT COMMANDS TO SUBSYSTEMS (EXCEPT GLOBAL AND SYSOP)                 *
  1264. ' *
  1265. '
  1266.      IF WHERE.FOUND > LEN(ALL.OPTS$) - 11 THEN _
  1267.         IF USER.SECURITY.LEVEL < OPT.SEC(WHERE.FOUND) THEN _
  1268.            WHERE.FOUND = 0 : _
  1269.            EXIT SUB _
  1270.         ELSE EXIT SUB
  1271.      IF MID$(ORIG.COMMANDS$,WHERE.FOUND,1) = "G" THEN _
  1272.         EXIT SUB                          ' ACCEPT GOODBYE/GRAPHICS
  1273.      IF (WHERE.FOUND < STRT.POS) OR _
  1274.         (STRT.POS < BEG.FILE AND WHERE.FOUND => BEG.FILE ) OR _
  1275.         (STRT.POS < BEG.UTIL AND WHERE.FOUND => BEG.UTIL ) OR _
  1276.         (STRT.POS < BEG.LIBRARY AND WHERE.FOUND => BEG.LIBRARY ) THEN _
  1277.           WHERE.FOUND = 0                 ' REJECT: NOT IN SECTION
  1278. 1242 IF WHERE.FOUND > 0 AND LEN(Z$) = 1 THEN _
  1279.         EXIT SUB
  1280.      CALL CHKMACRO (Z$,FOUND)
  1281.      IF FOUND THEN _
  1282.         GOTO 1240
  1283.      END SUB
  1284. ' $SUBTITLE: 'CHKMACRO    - subroutine to check if macro exits and process'
  1285. ' $PAGE
  1286. '
  1287. '  SUBROUTINE NAME    -- CHKMACRO
  1288. '
  1289. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  1290. '                      STRNG$           STRING TO CHECK IF IS A MACRO
  1291. '                      MACRO.DRVPATH$   DRIVE/PATH WHERE MACROS ARE
  1292. '                      MACRO.EXTENSION$ EXTENSION OF MACROS
  1293. '
  1294. '  OUTPUT PARAMETERS - MACRO.FOUND      WHETHER A MACRO WAS FOUND
  1295. '                      STRNG$           SUBSTITUTE FOR COMMANDS
  1296. '                      COMMPORT.STACK$  REST OF MACRO
  1297. '                                      0 IF NOT FOUND
  1298. '
  1299. '  SUBROUTINE PURPOSE -- MACRO FILE IS CHECKED FOR SECURITY (1ST LINE).
  1300. '                        2ND LINE IS SUBSTITUTED FOR PASSED STRING
  1301. '                        AND PARSED.  REMAINING PART OF MACRO PUT INTO
  1302. '                        STACK TO BE EXECUTED.
  1303. '
  1304.      SUB CHKMACRO (STRNG$,MACRO.FOUND) STATIC
  1305.      MACRO.FOUND = FALSE
  1306.      FILNAME$ = MACRO.DRVPATH$ + STRNG$ + MACRO.EXTENSION$
  1307.      CALL BADFILE (FILNAME$,A)
  1308.      IF A > 1 THEN _
  1309.         EXIT SUB
  1310.      CALL FINDIT (FILNAME$)
  1311.      IF NOT OK THEN _
  1312.         EXIT SUB
  1313.      CALL READDIR (1)
  1314.      IF EC > 0 THEN _
  1315.         EXIT SUB
  1316.      CALL CHECKINT (A$)
  1317.      IF EC > 0 OR USER.SECURITY.LEVEL < TESTED.INTEGER.VALUE THEN _
  1318.         EXIT SUB
  1319.      CALL READDIR (1)
  1320.      IF EC > 0 THEN _
  1321.         EXIT SUB
  1322.      MACRO.FOUND = TRUE
  1323.      STRNG$ = A$
  1324.      B$ = STRNG$
  1325.      CALL PARSEIT
  1326.      Y$ = ""
  1327.      WHILE NOT EOF(2)
  1328.         CALL READDIR (1)
  1329.         Y$ = Y$ + A$ + CARRIAGE.RETURN$
  1330.      WEND
  1331.      COMMPORT.STACK$ = COMMPORT.STACK$ + Y$
  1332.      END SUB
  1333. ' $SUBTITLE: 'VIEWHELP    - Processes requests for help'
  1334. ' $PAGE
  1335. '
  1336. '  SUBROUTINE NAME    -- VIEWHELP
  1337. '
  1338. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  1339. '                       SECTION             ORDER OF 1ST COMMAND IN CURRENT
  1340. '                                              SECTION
  1341. '                       GRAPHICS.DEFAULT    WHAT GRAPHICS TYPE USER WANTS
  1342. '                       HELP.DEFAULT$       HELP GET IF PRESS ENTER
  1343. '                       HELP.PATH$
  1344. '                       HELP.EXTENSION$
  1345. '                       BEG.FILE
  1346. '                       BEG.MAIN
  1347. '                       BEG.UTIL
  1348. '                       BEG.LIBRARY
  1349. '
  1350. '  OUTPUT PARAMETERS  -- DISPLAYS HELP
  1351. '
  1352. '  SUBROUTINE PURPOSE -- THE MAIN HELP PROCESSOR FOR RBBS.  PUTS UP THE
  1353. '                        OPTIONAL MENU.  ACCEPTS HELP WITH INDIVIDUAL
  1354.      SUB VIEWHELP (SECTION,GRAPHIC.DEFAULT$,HELP.DEFAULT$) STATIC
  1355. 1330 HELP.MENU$ = HELP.PATH$ + _
  1356.                   "HELP" + _
  1357.                   HELP.EXTENSION$
  1358.      GOT.MENU = TRUE
  1359.      IF Q > 1 THEN _
  1360.         ANS.INDEX = 2 : _
  1361.         LAST.INDEX = Q: _
  1362.         FAST.HELP = TRUE : _
  1363.         GOTO 1332
  1364. 1331 IF GOT.MENU THEN _
  1365.         FILE.NAME$ = HELP.MENU$ : _
  1366.         GOSUB 1350 : _
  1367.         GOT.MENU = FALSE
  1368.      ANS.INDEX = 1
  1369.      A$ = "Help with what Command (or TOPIC name)" + _
  1370.           PRESS.ENTER.EXPERT$
  1371.      SUBROUTINE.PARAMETER = 1
  1372.      CALL TGET
  1373.      IF SUBROUTINE.PARAMETER = -1 THEN _
  1374.         EXIT SUB
  1375.      IF Q = 0 THEN _
  1376.         EXIT SUB
  1377.      LAST.INDEX = Q
  1378. 1332 Z$ = B$(ANS.INDEX)
  1379.      CALL ALLCAPS (Z$)
  1380.      IF Z$ = "?" THEN _
  1381.         Z$ = "H"
  1382.      CALL BADFILE (Z$,BAD.FILE.NAME.INDEX)
  1383.      ON BAD.FILE.NAME.INDEX GOTO 1333,1340,1340
  1384. 1333 IF LEN(Z$) = 1 THEN _
  1385.         CALL SRCHCMND (SECTION,FF) : _
  1386.         IF FF < 1 THEN _
  1387.            OK = FALSE : _
  1388.            GOTO 1334 _
  1389.         ELSE X = - (FF => BEG.MAIN) - (FF => BEG.FILE) - (FF => BEG.UTIL) - (FF => BEG.LIBRARY) : _
  1390.              Z$ = MID$("MFU@",X,1) + _
  1391.                   MID$(ORIG.COMMANDS$,FF,1)
  1392.      FILE.NAME$ = HELP.PATH$ + _
  1393.                   Z$ + _
  1394.                   HELP.EXTENSION$
  1395.      GOSUB 1350
  1396. 1334 IF NOT OK THEN _
  1397.         A$ = "No help for " + _
  1398.              Z$ : _
  1399.         CALL QTPUT (A$,1) : _
  1400.         CALL UPDTCALR (A$,2)
  1401.      ANS.INDEX = ANS.INDEX + 1
  1402.      IF ANS.INDEX <= LAST.INDEX THEN _
  1403.         GOTO 1332
  1404.      IF FAST.HELP THEN _
  1405.         FAST.HELP = FALSE : _
  1406.         EXIT SUB
  1407.      GOTO 1331
  1408. 1340 OK = FALSE
  1409.      GOTO 1334
  1410. 1350 CALL GRAPHIC (GRAPHIC.DEFAULT$)
  1411.      CALL BUFFILE (FILE.NAME$,X)
  1412.      RETURN
  1413.      END SUB
  1414. ' $SUBTITLE: 'VIOLATION - handles all security violations'
  1415. ' $PAGE
  1416. '
  1417. '  SUBROUTINE NAME    -- SVIOLATION
  1418. '
  1419. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1420. '
  1421. '  OUTPUT PARAMETERS  -- CURSOR.LINE               CURRENT LINE ON SCREEN
  1422. '                        CURSOR.ROW                CURRENT ROW ON CURSOR.LINE
  1423. '
  1424. '  SUBROUTINE PURPOSE -- INFORM CALLER OF SECURITY VIOLATION, AUGMENT COUNT OF
  1425. '                        VIOLATIONS AND DETERMINE WHETHER TOO MANY OCCURRED.
  1426. '
  1427. 1380 SUB SVIOLATION STATIC
  1428.      CALL BUFFILE (SECVIO.HLP$,X)
  1429.      IF NOT OK THEN _
  1430.         CALL QTPUT ("Sorry, " + FIRST.NAME$ + ", SYSOP must authorize",1)
  1431.      CALL UPDTCALR ("SV!-" + VIOLATION$,2)
  1432.      CALL MUZAK (3)
  1433.      VIOLATIONS.THIS.SESSION = VIOLATIONS.THIS.SESSION + 1
  1434.      IF MAXIMUM.VIOLATIONS = 0 OR VIOLATIONS.THIS.SESSION <= MAXIMUM.VIOLATIONS THEN _
  1435.         EXIT SUB
  1436. 1385 IF USER.FILE.INDEX < 1 THEN _
  1437.         EXIT SUB
  1438.      A$ = "SECURITY VIOLATION!  Sysop can reinstate"
  1439.      IF USER.SECURITY.LEVEL <= MINIMUM.LOGON.SECURITY THEN _
  1440.         A$ = "" : _
  1441.         USER.SECURITY.LEVEL = USER.SECURITY.LEVEL - 1 _
  1442.      ELSE USER.SECURITY.LEVEL = MINIMUM.LOGON.SECURITY
  1443.      DENY.ACCESS = TRUE
  1444.      END SUB
  1445. ' $SUBTITLE: 'DENYACCESS - subroutine to build/display RBBS-PCs line 25'
  1446. ' $PAGE
  1447. '
  1448. '  SUBROUTINE NAME    -- DENYACCESS
  1449. '
  1450. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1451. '
  1452. '  OUTPUT PARAMETERS  -- (USER'S RECORD)
  1453. '
  1454. '  SUBROUTINE PURPOSE -- PERMANENTLY RESETS USER'S SECURITY LEVEL
  1455. '                        WHEN DENIED ACCESS
  1456. '
  1457.      SUB DENYACCESS STATIC
  1458. 1386 CALL TPUT
  1459.      LOGON.ERROR.INDEX = 5
  1460.      SUBROUTINE.PARAMETER = 6
  1461.      CALL FILELOCK
  1462.      CALL OPENUSER (HIGHEST.USER.RECORD)
  1463.      FIELD 5, 128 AS USER.RECORD$
  1464.      GET 5,USER.FILE.INDEX
  1465.      MID$(USER.RECORD$,47,2) = MKI$(USER.SECURITY.LEVEL)
  1466.      PUT 5,USER.FILE.INDEX
  1467.      SUBROUTINE.PARAMETER = 8
  1468.      CALL FILELOCK
  1469.      END SUB
  1470. ' $SUBTITLE: 'TPUT -- RBBS-PC common routine to write to comm. port'
  1471. ' $PAGE
  1472. '
  1473. '  SUBROUTINE NAME    -- TPUT (TERMINAL PUT)
  1474. '
  1475. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1476. '                                A$                 STRING TO WRITE TO THE
  1477. '                                                   COMMUNICATIONS PORT
  1478. '                         SUBROUTINE.PARAMETER = 1  SKIP A LINE BEFORE WRITING
  1479. '                                                   TO THE COMMUNICATIONS PORT
  1480. '                         SUBROUTINE.PARAMETER = 2  SKIP A LINE BEFORE WRITING
  1481. '                                                   TO THE COMMUNICATIONS PORT
  1482. '                                                   AND THEN SKIP TWO LINES
  1483. '                                                   AFTER WRITING TO THE COMM-
  1484. '                                                   UNICATIONS PORT
  1485. '                         SUBROUTINE.PARAMETER = 3  WRITE TO THE COMMUNICATIONS
  1486. '                                                   PORT AND THEN SKIP TWO
  1487. '                                                   LINES
  1488. '                         SUBROUTINE.PARAMETER = 4  WRITE TO THE COMMUNICATIONS
  1489. '                                                   PORT WITHOUT A CR/LF
  1490. '                         SUBROUTINE.PARAMETER = 5  WRITE TO THE COMMUNICATIONS
  1491. '                                                   PORT WITH A CR/LF
  1492. '                         SUBROUTINE.PARAMETER = 6  RESET EVERYTHING FOR INPUT
  1493. '                                                   STRING
  1494. '                         SUBROUTINE.PARAMETER = 7  RE-ENTRY AFTER HANDLING A
  1495. '                                                   FUNCTION KEY
  1496. '
  1497. '  OUTPUT PARAMETERS  --  SUBROUTINE.PARAMETER = -1 CARRIER HAS BEEN DROPPED
  1498. '                         FUNCTION.KEY        <>  0 FUNCTION KEY PRESSED
  1499. '
  1500. '  SUBROUTINE PURPOSE --  COMMON OUTPUT ROUTINE FOR RBBS-PC TO THE
  1501. '                         COMMUNICATIONS PORT (TERMINAL PUT)
  1502.       SUB TPUT STATIC
  1503.       IF SUBROUTINE.PARAMETER <> 7 THEN _
  1504.          PARM = SUBROUTINE.PARAMETER
  1505.       ON SUBROUTINE.PARAMETER GOTO 1398,1399,1400,1403,1405,1450,1411
  1506. '
  1507. ' *
  1508. ' *  COMMON OUTPUT ROUTINE                                                    *
  1509. ' *
  1510. '
  1511. 1398 CALL SKIPLINE (1)
  1512.      GOTO 1405
  1513. 1399 CALL SKIPLINE (1)
  1514. 1400 CR = 1
  1515. 1403 CR = CR + 1
  1516. 1405 RET = FALSE
  1517.      IF CM THEN _
  1518.         GOTO 1435
  1519. 1410 CALL FINDFUNC
  1520.      IF SUBROUTINE.PARAMETER < 0 THEN _
  1521.         EXIT SUB
  1522. 1411 Y$ = KEY.PRESSED$
  1523.      SUBROUTINE.PARAMETER = PARM
  1524.      IF LOCAL.USER THEN _
  1525.         GOTO 1430
  1526.      CALL EOFCOMM (CHAR%)
  1527.      IF CHAR% = -1 THEN _
  1528.         CALL CARRIER : _
  1529.         IF SUBROUTINE.PARAMETER = -1 THEN _
  1530.            EXIT SUB _
  1531.         ELSE GOTO 1430
  1532.      CALL GETCOM(Y$)
  1533. 1425 IF SUBROUTINE.PARAMETER = -1 THEN _
  1534.         EXIT SUB
  1535. 1430 IF Y$ = "" THEN _
  1536.         GOTO 1435
  1537.      ON INSTR(INTERRUPT.ON$,Y$) GOTO 1434,1434,1473,1475,1433
  1538.      GOSUB 1476
  1539.      GOTO 1435
  1540. 1433 GOSUB 1476
  1541.      IF ASC(RIGHT$(COMMPORT.STACK$,2)) = 13 OR _
  1542.         STOP.INTERRUPTS THEN _
  1543.         GOTO 1435  'stack if series of [ENTER]s or no previous stack
  1544.      GOTO 1471
  1545. 1434 IF STOP.INTERRUPTS THEN _
  1546.         GOTO 1435
  1547.      COMMPORT.STACK$ = ""
  1548.      IF FOSSIL THEN _
  1549.         CALL FOSTXPURGE(COMPORT%) : _
  1550.         CALL FOSRXPURGE(COMPORT%)
  1551.      GOTO 1471
  1552. 1435 LOCATE ,,1
  1553.      CALL PSCRN (A$)
  1554. 1437 IF UPPER.CASE THEN _
  1555.         IF GR <> 2 THEN _
  1556.            CALL ALLCAPS (A$)
  1557.      CALL PUTCOM (A$)
  1558. 1450 IF CR <> 1 THEN _
  1559.         CALL SKIPLINE (1) _
  1560.      ELSE IF CR > 1 THEN _
  1561.              CALL SKIPLINE (1)
  1562. 1470 CR = 0
  1563.      TOA! = FRE("A")
  1564.      EXIT SUB
  1565. 1471 CALL SKIPLINE (1)
  1566.      STOP.INTERRUPTS = FALSE
  1567.      RET = TRUE
  1568.      NON.STOP = FALSE
  1569.      GOTO 1470
  1570. 1473 XOFF.ED = TRUE
  1571.      GOTO 1410
  1572. 1475 XOFF.ED = FALSE
  1573.      GOTO 1410
  1574. 1476 IF ASC(Y$) < 127 THEN _
  1575.         COMMPORT.STACK$ = COMMPORT.STACK$ + Y$
  1576.      RETURN
  1577.      END SUB
  1578. ' $SUBTITLE: 'QTPUT    - subroutine to quickly write to terminal'
  1579. ' $PAGE
  1580. '
  1581. '  SUBROUTINE NAME    -- QTPUT
  1582. '
  1583. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  1584. '                        STRNG$        STRING TO WRITE OUT
  1585. '                        NUM.RETURNS   NUMBER OF CARRIAGE RETURNS
  1586. '
  1587. '  OUTPUT PARAMETERS  -- NONE
  1588. '
  1589. '  SUBROUTINE PURPOSE -- SUBROUTINE TO QUICKLY WRITE TO THE TERMINAL.  THIS IS
  1590. '                        IS DIFFERENT FROM "TPUT" IN THE THINGS IT DOESN'T DO:
  1591. '                                A.) NO FUNCTION KEY CHECK,
  1592. '                                B.) NO CONVERSION TO UPPER CASE,
  1593. '                                C.) NO STRING RE-INITILIZATION OF "STRNG$",
  1594. '                                D.) NO CHECK FOR CARRIER PRESENT, AND
  1595. '                                E.) NO CHECK FOR IMBEDDED CARRIAGE RETURN IN
  1596. '                                       "STRNG$".
  1597. '                                F.) NO SUPPORT FOR XON/XOFF
  1598. '
  1599.       SUB QTPUT (STRNG$,NUM.RETURNS) STATIC
  1600.       IF USE.TPUT THEN _
  1601.          A$ = STRNG$ : _
  1602.          SUBROUTINE.PARAMETER = 4 : _
  1603.          CALL TPUT : _
  1604.          CALL SKIPLINE (NUM.RETURNS) : _
  1605.          EXIT SUB
  1606.       CALL PUTCOM (STRNG$)
  1607.       LOCATE ,,1
  1608.       CALL PSCRN (STRNG$)
  1609.       CALL SKIPLINE (NUM.RETURNS)
  1610.       END SUB
  1611. ' $SUBTITLE: 'LPRNT    - subroutine to write to display'
  1612. ' $PAGE
  1613. '
  1614. '  SUBROUTINE NAME    -- LPRNT
  1615. '
  1616. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  1617. '                        STRNG$        STRING TO WRITE OUT
  1618. '                        NUM.RETURNS   NUMBER OF CARRIAGE RETURNS
  1619. '
  1620. '  OUTPUT PARAMETERS  -- NONE
  1621. '
  1622. '  SUBROUTINE PURPOSE -- SUBROUTINE TO WRITE TO THE DISPLAY.
  1623. '
  1624. 1480  SUB LPRNT (STRNG$,NUM.RETURNS) STATIC
  1625.       IF NOT SNOOP THEN _
  1626.          EXIT SUB
  1627.       CALL PSCRN (STRNG$)
  1628.       IF USE.BASIC.WRITES THEN _
  1629.          FOR I = 1 TO NUM.RETURNS : _
  1630.             PRINT : _
  1631.          NEXT : _
  1632.       ELSE FOR I = 1 TO NUM.RETURNS : _
  1633.               LOCATE ,,1 : _
  1634.               CALL ANSI(CRLF$,C.L,C.C) : _
  1635.               LOCATE C.L,C.C : _
  1636.               NEXT
  1637.       END SUB
  1638. ' $SUBTITLE: 'QLPRNT    - subroutine to quickly write to display'
  1639. ' $PAGE
  1640. '
  1641. '  SUBROUTINE NAME    -- QLPRNT
  1642. '
  1643. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  1644. '                        STRNG$        STRING TO WRITE OUT
  1645. '                        NUM           NUMBER OF CARRIAGE RETURNS
  1646. '
  1647. '  OUTPUT PARAMETERS  -- NONE
  1648. '
  1649. '  SUBROUTINE PURPOSE -- SUBROUTINE TO QUICKLY WRITE TO THE DISPLAY.
  1650. '                        OVERWRITES, AND PUTS UP COUNT
  1651.       SUB QLPRNT (STRNG$,NUM) STATIC
  1652.       LOCATE ,1,1
  1653.       CALL PSCRN (STRNG$ + STR$(NUM))
  1654.       END SUB
  1655. ' $SUBTITLE: 'PSCRN    - subroutine to print to the screen'
  1656. ' $PAGE
  1657. '
  1658. '  SUBROUTINE NAME    -- PSCRN
  1659. '
  1660. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  1661. '                        STRNG$        STRING TO WRITE OUT
  1662. '
  1663. '  OUTPUT PARAMETERS  -- NONE
  1664. '
  1665. '  SUBROUTINE PURPOSE -- Assumes you already have positioned
  1666. '                        cursor where you want.
  1667. '
  1668.       SUB PSCRN (STRNG$) STATIC
  1669.       IF NOT SNOOP THEN _
  1670.          EXIT SUB
  1671.       IF STRNG$ = "" THEN _
  1672.          EXIT SUB
  1673.       IF USE.BASIC.WRITES THEN _
  1674.          PRINT STRNG$; _
  1675.       ELSE CALL ANSI (STRNG$,C.L,C.C) : _
  1676.            LOCATE C.L,C.C
  1677.       END SUB
  1678. ' $SUBTITLE: 'SKIPLINE - subroutine to write a blank line to user'
  1679. ' $PAGE
  1680. '
  1681. '  SUBROUTINE NAME    -- SKIPLINE
  1682. '
  1683. '  INPUT PARAMETERS   --   PARAMETER             MEANING
  1684. '                        LOCAL.USER
  1685. '                        MODEM.STATUS.REGISTER
  1686. '                        NUM.RETURNS
  1687. '                        RETURN.LINE.FEED$
  1688. '                        SNOOP
  1689. '
  1690. '  OUTPUT PARAMETERS  -- NONE
  1691. '
  1692. '  SUBROUTINE PURPOSE -- SKIP A LINE ON THE USER'S TERMINAL
  1693. '
  1694.       SUB SKIPLINE (NUM.RETURNS) STATIC
  1695. 1485  FOR I=1 TO NUM.RETURNS
  1696.           CALL PUTCOM (RETURN.LINE.FEED$)
  1697.       NEXT
  1698.       IF NOT SNOOP THEN _
  1699.          GOTO 1486
  1700.       IF USE.BASIC.WRITES THEN _
  1701.          FOR I = 1 TO NUM.RETURNS : _
  1702.             PRINT : _
  1703.          NEXT : _
  1704.       ELSE FOR I = 1 TO NUM.RETURNS : _
  1705.               LOCATE ,,1 : _
  1706.               CALL ANSI(CRLF$,C.L,C.C) : _
  1707.               LOCATE C.L,C.C : _
  1708.               NEXT
  1709. 1486  LINES.PRINTED = LINES.PRINTED + NUM.RETURNS
  1710.       UNIT.COUNT = UNIT.COUNT - DISPLAY.AS.UNIT * NUM.RETURNS
  1711.       END SUB
  1712. ' $SUBTITLE: 'SETCRLF -- subroutine to set up nulls/lf's for output'
  1713. ' $PAGE
  1714. '
  1715. '  SUBROUTINE NAME    -- SETCRLF
  1716. '
  1717. '  INPUT PARAMETERS   --   PARAMETER          MEANING
  1718. '                        CARRIAGE.RETURN$    CARRIAGE RETURN CHARACTER
  1719. '                        LINE.FEED$          LINE FEED CHARACTER
  1720. '                        LINE.FEEDS          LINE FEED SWITCH
  1721. '                        NUL$                NULL CHARACTER
  1722. '
  1723. '  OUTPUT PARAMETERS  -- RETURN.LINE.FEED$   END-OF-LINE STRING
  1724. '
  1725. '  SUBROUTINE PURPOSE -- SET UP THE NECESSARCY NULLS/LINE FEEDS TO END
  1726. '                        EACH OUTPUT TO THE COMMUNICATIONS PORT WITH
  1727. '
  1728.       SUB SETCRLF STATIC
  1729. 1496  RETURN.LINE.FEED$ = _
  1730.          MID$(CARRIAGE.RETURN$,1, - (NOT LOCAL.USER)) + _
  1731.          NUL$ + _
  1732.          MID$(LINE.FEED$,1, - (LINE.FEEDS <> 0))
  1733.       END SUB
  1734. ' $SUBTITLE: 'TGET -- RBBS-PC common routine to ask a user a question'
  1735. ' $PAGE
  1736. '
  1737. '  SUBROUTINE NAME    -- TGET
  1738. '
  1739. '  INPUT PARAMETERS   --    PARAMETER                   MEANING
  1740. '                         SUBROUTINE.PARAMETER = 1  STANDARD ENTRY
  1741. '                         SUBROUTINE.PARAMETER = 2  ENTRY AFTER A FUNCTION KEY
  1742. '                                                   HAS BEEN HANDLED
  1743. '                                A$                 STRING TO WRITE TO THE
  1744. '                                                   COMMUNICATIONS PORT
  1745. '                         HIDDEN                    IF THIS IS TRUE THEN ECHO
  1746. '                                                   '.' INSTEAD OF ACTUAL
  1747. '                                                   CHARACTER ENTERED.
  1748. '                         FORCE.KEYBOARD            IF TRUE, STACKED INPUT
  1749. '                                                   IS BYPASSED AND KEYBOARD
  1750. '                                                   INPUT IS READ.
  1751. '
  1752. '  OUTPUT PARAMETERS  --  SUBROUTINE.PARAMETER = -1 CARRIER HAS BEEN DROPPED
  1753. '                         B$                        STRING THAT WAS ENTERED
  1754. '                         Q                         NUMBER OF PARAMETERES THAT
  1755. '                                                   WERE ENTERED WHICH WHERE
  1756. '                                                   SEPARATED BY A SEMICOLON
  1757. '                         B$()                      STRING MATRIX WITH EACH
  1758. '                                                   ITEM CONTAIN THE STRING
  1759. '                                                   THAT WAS ENTERED BETWEEN
  1760. '                                                   SEMICOLONS.
  1761. '                         FUNCTION.KEY        <>  0 FUNCTION KEY PRESSED
  1762. '                         YES                       REPLY IS "Y" OR "YES"
  1763. '                         NO                        REPLY IS "N" OR "NO"
  1764. '                         NON.STOP                  REPLY IS "NS" OR "ns"
  1765. '                         KILL.MESSAGE              REPLY IS "K"
  1766. '                         REPLY                     REPLY IS "RE"
  1767. '
  1768. '  SUBROUTINE PURPOSE --  COMMON ROUTINE TO ASK A USER A QUESTION
  1769. '
  1770.       SUB TGET STATIC
  1771.       ON SUBROUTINE.PARAMETER GOTO 1500,1526
  1772. '
  1773. ' *
  1774. ' *  COMMON INPUT ROUTINE                                                     *
  1775. ' *
  1776. '
  1777. 1500 CALL CARRIER
  1778.      IF SUBROUTINE.PARAMETER = -1 THEN _
  1779.         EXIT SUB
  1780.      LINES.PRINTED = 0
  1781.      DISPLAY.AS.UNIT = FALSE
  1782.      TOA! = FRE("A")
  1783.      CALL SETABORT (AUTO.LOGOFF!, WAIT.BEFORE.DISCONNECT)
  1784.      AUTO.WARN! = AUTO.LOGOFF! - 30
  1785.      A = 0
  1786.      B = 0
  1787.      C = 0
  1788.      Q = 1
  1789.      PARM = 0
  1790.      EOL = FALSE
  1791.      YES = FALSE
  1792.      B$ = ""
  1793.      SLEEP.WARN = TRUE
  1794.      NO = FALSE
  1795.      CALL COLORPMT (A$)
  1796.      A$ = A$ + _
  1797.           MID$("? !  ",2*TURBO.KEY+1,2)
  1798.      SUBROUTINE.PARAMETER = 4
  1799.      STOP.SAVE = STOP.INTERRUPTS
  1800.      STOP.INTERRUPTS = TRUE
  1801.      CALL TPUT
  1802.      STOP.INTERRUPTS = STOP.SAVE
  1803.      IF SUBROUTINE.PARAMETER = -1 OR FUNCTION.KEY <> 0 THEN _
  1804.         EXIT SUB
  1805. 1523 IF PROMPT.BELL THEN _
  1806.         IF LOCAL.USER THEN _
  1807.            BEEP_
  1808.         ELSE CALL PUTCOM(BELL.RINGER$)
  1809. 1525 CALL CARRIER
  1810.      IF SUBROUTINE.PARAMETER = -1 THEN _
  1811.         EXIT SUB
  1812.      IF (NOT FORCE.KEYBOARD) AND LEN(COMMPORT.STACK$) > 0 THEN _
  1813.         Y$ = LEFT$(COMMPORT.STACK$,1) : _
  1814.         COMMPORT.STACK$ = RIGHT$(COMMPORT.STACK$,LEN(COMMPORT.STACK$)-1) : _
  1815.         GOTO 1541
  1816.      IF LOCAL.USER THEN _
  1817.         CALL FINDFUNC: _
  1818.         IF SUBROUTINE.PARAMETER < 0 THEN _
  1819.            EXIT SUB _
  1820.         ELSE GOTO 1526
  1821.      CALL EOFCOMM (CHAR%)
  1822.      IF CHAR% <> -1 THEN _
  1823.         CALL GETCOM(Y$) : _
  1824.         IF SUBROUTINE.PARAMETER = -1 THEN _
  1825.            EXIT SUB _
  1826.         ELSE GOTO 1541
  1827.      CALL FINDTIME (TI!)
  1828.      IF TI! > AUTO.WARN! THEN _
  1829.         IF TI! > AUTO.LOGOFF! THEN _
  1830.            CALL UPDTCALR ("Sleep disconnect",1) : _
  1831.            SUBROUTINE.PARAMETER = -1 : _
  1832.            EXIT SUB _
  1833.         ELSE IF SLEEP.WARN THEN _
  1834.                 SLEEP.WARN = FALSE : _
  1835.                 A$ = "LOGGING you OFF if you do not respond in 30 seconds!" : _
  1836.                 CALL RINGCALLER
  1837.      CALL FINDFUNC
  1838.      IF SUBROUTINE.PARAMETER < 0 THEN _
  1839.         EXIT SUB
  1840. 1526 Y$ = KEY.PRESSED$
  1841.      IF Y$ <> "" THEN _
  1842.         GOTO 1545
  1843.      SEND.REMOTE = TRUE
  1844.      CALL GOIDLE
  1845.      GOTO 1525
  1846. 1541 SEND.REMOTE = REMOTE.ECHO
  1847.      IF TEST.PARITY THEN _
  1848.         GOTO 1542
  1849.      IF Y$ = CHR$(127) THEN _
  1850.         GOTO 1635
  1851.      GOTO 1545
  1852. 1542 IF Y$ = "" THEN _
  1853.         Y$ = " "
  1854.      IF ASC(Y$) = 141 THEN _
  1855.         OUT LINE.CONTROL.REGISTER,&H1A : _
  1856.         EIGHT.BIT = FALSE : _
  1857.         TEST.PARITY = FALSE : _
  1858.         GR = FALSE
  1859.      Y$ = CHR$(ASC(Y$) AND 127)
  1860. 1545 IF INSTR(LINEEDIT.CHK$,Y$) > 5 _
  1861.         GOTO 1635
  1862.      IF Y$ < " " AND Y$ <> CARRIAGE.RETURN$ THEN _
  1863.         GOTO 1525
  1864.      IF Y$ = "^" THEN _
  1865.         GOTO 1525
  1866.      IF Y$ = CARRIAGE.RETURN$ THEN _
  1867.         GOTO 1547 _
  1868.      ELSE GOSUB 1550
  1869.      IF TURBO.KEY < 1 THEN _
  1870.         GOTO 1546
  1871.      IF Y$ = " " THEN _
  1872.         Y$ = ""
  1873.      IF Y$ <> "/" THEN _
  1874.         B$ = Y$ : _
  1875.         Y$ = CARRIAGE.RETURN$ : _
  1876.         GOTO 1547
  1877.      TURBO.KEY = 0
  1878.      GOTO 1525
  1879. 1546 IF LEN(B$) => 254 THEN _
  1880.         A$ = "Input too long!" : _
  1881.         SUBROUTINE.PARAMETER = 5 : _
  1882.         CALL TPUT : _
  1883.         IF SUBROUTINE.PARAMETER = -1 OR FUNCTION.KEY <> 0 THEN _
  1884.            EXIT SUB _
  1885.         ELSE GOTO 1500
  1886.      B$ = B$ + _
  1887.           Y$
  1888.      GOTO 1525
  1889. 1547 TURBO.KEY = FALSE          ' Carriage Return Handler
  1890.      HIDDEN = FALSE
  1891.      IF NO.ADVANCE THEN _
  1892.         NO.ADVANCE = FALSE : _
  1893.         GOTO 1575 _
  1894.      ELSE CALL LPRNT (CRLF$,0) : _
  1895.           GOSUB 1551 : _
  1896.           GOTO 1570
  1897. 1550 CALL LPRNT(Y$,0)
  1898. 1551 IF NOT SEND.REMOTE THEN _
  1899.         RETURN
  1900. 1552 IF LOGON.ACTIVE THEN _
  1901.         IF (Y$ = " " OR Y$ = ";") AND _
  1902.            RIGHT$(B$,1) <> " " AND RIGHT$(B$,1) <> ";" THEN _
  1903.               PARM = PARM + 1 : _
  1904.               LOGON.ACTIVE = (PARM < 3) : _
  1905.               GOTO 1553
  1906.      IF HIDDEN OR _
  1907.         (LOGON.ACTIVE AND PARM = 2) THEN _
  1908.            CALL PUTCOM (".") : _
  1909.            RETURN
  1910. 1553 CALL PUTCOM (Y$)
  1911.      RETURN
  1912. 1570 IF SEND.REMOTE THEN _
  1913.         IF LINE.FEEDS THEN _
  1914.            CALL PUTCOM (LINE.FEED$)
  1915. 1575 IF LEN(B$) > 4000 THEN _
  1916.         A$ = "Try again, " + _
  1917.              FIRST.NAME$ : _
  1918.         SUBROUTINE.PARAMETER = 5 : _
  1919.         CALL TPUT : _
  1920.         IF SUBROUTINE.PARAMETER = -1 OR FUNCTION.KEY <> 0 THEN _
  1921.            EXIT SUB _
  1922.         ELSE GOTO 1500
  1923.      IF PARSE.OFF THEN _
  1924.         PARSE.OFF = FALSE : _
  1925.         GOTO 1620
  1926.      CALL PARSEIT
  1927.      IF Q = 1 THEN _
  1928.         GOTO 1620
  1929.      GOTO 1625
  1930. 1620 B$(1) = B$
  1931.      Q = 1
  1932.      IF B$ = "" THEN _
  1933.         Q = 0 : _
  1934.         EXIT SUB
  1935. 1625 IF LEN(B$) < 4 THEN _
  1936.         X$ = LEFT$(B$,3): _
  1937.         CALL ALLCAPS (X$) : _
  1938.         IF X$ = "Y" OR X$ = "YES" THEN _
  1939.            YES = TRUE _
  1940.         ELSE IF X$ = "N" OR X$ = "NO" OR X$ = "A" THEN _
  1941.                 NO = TRUE _
  1942.              ELSE IF X$ = "RE" THEN _
  1943.                      REPLY = TRUE : _
  1944.                      EXIT SUB _
  1945.                   ELSE IF X$ = "K" THEN _
  1946.                           KILL.MESSAGE = TRUE : _
  1947.                        EXIT SUB
  1948.      IF B$(Q) = "NS" OR B$(Q) = "ns" THEN _
  1949.         NON.STOP = TRUE : _
  1950.         B$(Q) = "" : _
  1951.         IF Q > 1 THEN _
  1952.            Q = Q-1
  1953.      FORCE.KEYBOARD = FALSE
  1954.      EXIT SUB
  1955. 1635 IF LEN(B$) = 0 THEN _
  1956.         GOTO 1525
  1957.      IF LOGON.ACTIVE THEN _
  1958.         IF INSTR(" ;",RIGHT$(B$,1)) > 0 THEN _
  1959.            PARM = PARM - 1
  1960.      B$ = LEFT$(B$,LEN(B$)-1)
  1961.      CALL LPRNT(LOCAL.BACKSPACE$,0)
  1962.      IF SEND.REMOTE THEN _
  1963.         CALL PUTCOM(BACKSPACE$)
  1964.      GOTO 1525
  1965.      END SUB
  1966. ' $SUBTITLE: 'RINGCALLER - subroutine to use sound + screen emphasis'
  1967. ' $PAGE
  1968. '
  1969. '  SUBROUTINE NAME    -- RINGCALLER
  1970. '
  1971. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1972. '                         A$                           STRING TO EMPHASIZE
  1973. '
  1974. '  OUTPUT PARAMETERS  --  none
  1975. '
  1976. '  SUBROUTINE PURPOSE --  Rings the users bell before and after string
  1977. '                         (but not snooping sysop) and adds emphasis around
  1978. '                         message sent.
  1979. '
  1980.      SUB RINGCALLER STATIC
  1981.      X$ = LEFT$(BELL.RINGER$,-LOCAL.USER)
  1982.      CALL PUTCOM (BELL.RINGER$)
  1983.      CALL LPRNT (X$,0)
  1984.      SUBROUTINE.PARAMETER = 2
  1985.      A$ = EMPHASIZE.ON$ + A$ + EMPHASIZE.OFF$
  1986.      CALL TPUT
  1987.      CALL PUTCOM (BELL.RINGER$)
  1988.      CALL LPRNT (X$,0)
  1989.      END SUB
  1990. ' $SUBTITLE: 'PARSEIT - subroutine to parse a string'
  1991. ' $PAGE
  1992. '
  1993. '  SUBROUTINE NAME    -- PARSEIT
  1994. '
  1995. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1996. '                         B$                           STRING TO PARSE
  1997. '
  1998. '  OUTPUT PARAMETERS  --  Q                            NUMBER PARSED
  1999. '                         B$()                         PARSED STRINGS
  2000. '
  2001. '  SUBROUTINE PURPOSE --  TO PARSE A STRING INTO PIECES.  USES SEMICOLON
  2002. '                         IF EXISTS, OTHERWISE SPACE
  2003. '
  2004.      SUB PARSEIT STATIC
  2005.      A = INSTR(B$,";")
  2006.      IF A > 0 THEN _
  2007.         PARSE.CHAR$ = ";" _
  2008.      ELSE IF B$ <> SPACE$(LEN(B$)) THEN _
  2009.              CALL TRIM (B$) : _
  2010.              A = INSTR(B$,"  ") : _
  2011.              WHILE A > 0 : _
  2012.                 B$ = LEFT$(B$,A - 1) + _
  2013.                      MID$(B$,A + 1) : _
  2014.                 A = INSTR(A,B$,"  ") : _
  2015.              WEND : _
  2016.              A = INSTR(B$," ") : _
  2017.              PARSE.CHAR$ = " "
  2018.      IF A < 2 THEN _
  2019.         B$(1) = B$ : _
  2020.         EXIT SUB
  2021.      B$(1) = LEFT$(B$,A - 1)
  2022.      A = A + 1
  2023. 1640 B = INSTR(A,B$,PARSE.CHAR$)
  2024.      C = B-A
  2025.      IF C < 1 THEN _
  2026.         EOL = TRUE : _
  2027.         C = 128
  2028.      DF$ = MID$(B$,A,C)
  2029.      IF DF$ <> "" THEN _
  2030.         Q = Q + 1 : _
  2031.         B$(Q) = DF$
  2032.      IF NOT EOL AND Q < 10 THEN _
  2033.         A = B + 1 : _
  2034.         GOTO 1640
  2035.      END SUB
  2036. ' $SUBTITLE: 'SETBAUD - subroutine to set the baud rate in the RS232'
  2037. ' $PAGE
  2038. '
  2039. '  SUBROUTINE NAME    -- SETBAUD
  2040. '
  2041. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2042. '                         BAUD.RATE.DIVISOR   NUMBER TO DIVIDE THE 8250 CHIP'S
  2043. '                                             PROGRAMABLE CLOCK TO ADJUST THE
  2044. '                                             BAUD RATE TO THE USER'S BAUD
  2045. '                                             RATE (INDEPENDENT OF THE BAUD
  2046. '                                             RATE USED TO OPEN THE COMM. PORT)
  2047. '
  2048. '        DESIRED BAUD        DIVISIOR (DECIMAL) TO OBTAIN DESIRED BAUD RATE
  2049. '            RATE              PCjr         PC AND XT
  2050. '              50             2237             2304
  2051. '              75             1491             1536
  2052. '             110             1017             1047
  2053. '             134.5            832              857
  2054. '             150              746              768
  2055. '             300              373              384
  2056. '             600              186              192
  2057. '            1200               93               96
  2058. '            1800               62               64
  2059. '            2000               56               58
  2060. '            2400               47               48
  2061. '            3600               31               32
  2062. '            4800               23               24
  2063. '            7200          not available         16
  2064. '            9600          not available         12
  2065. '           19200          not available          6
  2066. '  OUTPUT PARAMETERS  -- BAUD RATE SET IN THE RS232 INTERFACE
  2067. '
  2068. '  SUBROUTINE PURPOSE -- TO SET THE BAUD RATE IN THE RS232 INTERFACE
  2069. '                        INDEPENDENT OF THE BAUD RATE THE COMMUNICATIONS PORT
  2070. '                        WAS OPENED AT
  2071. '
  2072.       SUB SETBAUD STATIC
  2073. 1654 IF NOT KEEP.INIT.BAUD THEN _
  2074.         TALK.TO.MODEM.AT$ =  MID$("      300  450 1200 2400 4800 960019200",(-5 * BPS),5) _
  2075.      ELSE TALK.TO.MODEM.AT$ = MODEM.INIT.BAUD$
  2076.      CALL TRIM (TALK.TO.MODEM.AT$)
  2077.      IF LEN(TALK.TO.MODEM.AT$) < 5 THEN _
  2078.         TALK.TO.MODEM.AT$ = SPACE$(4 - LEN(TALK.TO.MODEM.AT$)) + _
  2079.                             TALK.TO.MODEM.AT$
  2080.      IF EIGHT.BIT THEN_
  2081.         PARITY% = 2 : _                                    ' NO PARITY
  2082.         DATABITS% = 3 : _                                  ' 8 DATA BITS
  2083.         STOPBITS% = 0 _                                    ' 1 STOP BIT
  2084.      ELSE PARITY% = 3 : _                                  ' EVEN PARITY
  2085.           DATABITS% = 2 : _                                ' 7 DATA BITS
  2086.           STOPBITS% = 0                                    ' 1 STOP BIT
  2087.      COMSPEED% = VAL(TALK.TO.MODEM.AT$)
  2088.      IF FOSSIL THEN _
  2089.         CALL FOSSPEED(COMPORT%,COMSPEED%,PARITY%,DATABITS%,STOPBITS%) : _
  2090.         EXIT SUB
  2091.      IF COMSPEED% = 300 THEN _
  2092.         BAUD.RATE.DIVISOR = &H180 + (11 * (COMPUTER.TYPE = 2))
  2093.      IF COMSPEED% = 450 THEN _
  2094.         BAUD.RATE.DIVISOR = &H100 + (8 * (COMPUTER.TYPE = 2))
  2095.      IF COMSPEED% = 1200 THEN _
  2096.         BAUD.RATE.DIVISOR = &H60 + (3 * (COMPUTER.TYPE = 2))
  2097.      IF COMSPEED% = 2400 THEN _
  2098.         BAUD.RATE.DIVISOR = &H30 + (1 * (COMPUTER.TYPE = 2))
  2099.      IF COMSPEED% = 4800 THEN _
  2100.         BAUD.RATE.DIVISOR = &H18
  2101.      IF COMSPEED% = 9600 THEN _
  2102.         BAUD.RATE.DIVISOR = &HC
  2103.      IF COMSPEED% = 19200 THEN _
  2104.         BAUD.RATE.DIVISOR = &H6
  2105.      MOST.SIGNIFICANT.BYTE = FIX (BAUD.RATE.DIVISOR / 256)
  2106.      LEAST.SIGNIFICANT.BYTE = BAUD.RATE.DIVISOR - (MOST.SIGNIFICANT.BYTE * 256)
  2107.      LINE.CONTROL.STATUS = INP(LINE.CONTROL.REGISTER)
  2108.      MSB.SAVE = INP(MSB)
  2109.      OUT MSB,0
  2110.      OUT LINE.CONTROL.REGISTER,LINE.CONTROL.STATUS OR 128
  2111.      OUT LSB,LEAST.SIGNIFICANT.BYTE
  2112.      OUT MSB,MOST.SIGNIFICANT.BYTE
  2113.      OUT LINE.CONTROL.REGISTER,LINE.CONTROL.STATUS
  2114.      OUT MSB,MSB.SAVE
  2115.      END SUB
  2116. ' $SUBTITLE: 'MSGTO - subroutine to get who a message is to'
  2117. ' $PAGE
  2118. '
  2119. '  SUBROUTINE NAME    -- MSGTO
  2120. '
  2121. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2122. '                         HIGHEST.USER.RECORD
  2123. '
  2124. '  OUTPUT PARAMETERS  --  MESSAGE.TO$              Who message is to
  2125. '                         RECEIVER.REC.NUM         User record # of who to
  2126. '
  2127. '  SUBROUTINE PURPOSE --  Asks who a message is to and determines if receiver
  2128. '                         exists
  2129. '
  2130.      SUB MSGTO (HIGHEST.USER.RECORD,MESSAGE.TO$,RECEIVER.REC.NUM,FOUND) STATIC
  2131. 2020 IF MESSAGE.TO$ <> "" THEN _
  2132.         GOTO 2032
  2133.      A$ = "To [A]ll,S)ysop, or name"
  2134.      CALL SKIPLINE (1)
  2135.      GOSUB 2033
  2136.      IF LEN(B$) > 30 THEN _
  2137.         CALL QTPUT ("30 Char. Max",1) : _
  2138.         GOTO 2020
  2139. 2030 FOUND = TRUE
  2140.      IF Q = 0 THEN _
  2141.         MESSAGE.TO$ = "ALL" _
  2142.      ELSE CALL ALLCAPS (B$) : _
  2143.           IF B$ = "A" THEN _
  2144.              MESSAGE.TO$ = "ALL" : _
  2145.              EXIT SUB _
  2146.           ELSE IF B$ = "S" THEN _
  2147.              MESSAGE.TO$ = "SYSOP" _
  2148.           ELSE MESSAGE.TO$ = B$
  2149. 2032 IF MESSAGE.TO$ <> "ALL" THEN _
  2150.         IF LEFT$(MESSAGE.TO$,4) <> "ALL " AND _
  2151.            START.HASH = 1 AND (MESSAGE.TO$ = "SYSOP" OR _
  2152.            INSTR(MESSAGE.TO$," ") > 0) THEN _
  2153.            TEMP.HASH.VALUE$ = MESSAGE.TO$ : _
  2154.            CALL WHOCHECK (TEMP.HASH.VALUE$,FOUND,RECEIVER.REC.NUM) : _
  2155.            IF NOT FOUND THEN _
  2156.               Q = 0 : _
  2157.               A$ = "[R]e-enter name, Q)uit, C)ontinue" : _
  2158.               TURBO.KEY = -TURBO.KEY.USER : _
  2159.               GOSUB 2033 : _
  2160.               Z$ = B$(1) : _
  2161.               CALL ALLCAPS (Z$) : _
  2162.               IF Z$ <> "C" THEN _
  2163.                  MESSAGE.TO$ = "" : _
  2164.                  IF Z$ <> "Q" THEN _
  2165.                     GOTO 2020
  2166.      EXIT SUB
  2167. 2033 SUBROUTINE.PARAMETER = 1
  2168.      CALL TGET
  2169.      IF SUBROUTINE.PARAMETER = -1 THEN _
  2170.         EXIT SUB
  2171.      RETURN
  2172.      END SUB
  2173. ' $SUBTITLE: 'MSGPROT - gets protection wanted for a message'
  2174. ' $PAGE
  2175. '
  2176. '  SUBROUTINE NAME    -- MSGPROT
  2177. '
  2178. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2179. '                         MESSAGE.TO$
  2180. '                         FOUND
  2181. '
  2182. '  OUTPUT PARAMETERS  --  PASSWORD$                Protection desired
  2183. '
  2184. '  SUBROUTINE PURPOSE --  Sets protection desired for a new message
  2185. '
  2186.      SUB MSGPROT (MESSAGE.TO$,FOUND,MESSAGE.PASSWORD$) STATIC
  2187. 2060 A$ = "Make message p[U]blic, p(R)ivate, (P)assword protected, (H)elp"
  2188.      GOSUB 2093
  2189.      IF Q = 0 THEN _
  2190.         B$(1) = "U"
  2191.      Z$ = LEFT$(B$(1),1)
  2192.      CALL ALLCAPS (Z$)
  2193.      ON INSTR("RUPH",Z$) GOTO 2075,2090,2075,2070
  2194.      GOTO 2060
  2195. '
  2196. ' **  DISPLAY MESSAGE PROTECT HELP   **
  2197. '
  2198. 2070 CALL BUFFILE (HELP$(3),X)
  2199.      GOTO 2060
  2200. '
  2201. ' ** MAKE MESSAGE READ PROTECTED (ONLY ADDRESSEE AND SYSOP CAN READ IT) **
  2202. '
  2203. 2075 IF MESSAGE.TO$ = "ALL" THEN _
  2204.         CALL QTPUT("Msg to ALL cannot be private",1) : _
  2205.         GOTO 2060
  2206.      IF Z$ = "P" THEN _
  2207.         GOTO 2088
  2208. 2077 IF NOT FOUND THEN _
  2209.         IF ACTIVE.USER.NAME$ <> "SYSOP" THEN _
  2210.            CALL QTPUT ("Personal mail only to active users",1) : _
  2211.            MESSAGE.PASSWORD$ = "" : _
  2212.            EXIT SUB
  2213. 2081 CALL QTPUT ("Sending personal mail to " + MESSAGE.TO$,1)
  2214. 2084 MESSAGE.PASSWORD$ = "^READ^"
  2215.      EXIT SUB
  2216. 2085 A$ = "Password"
  2217.      GOSUB 2094
  2218.      IF Q = 0 THEN _
  2219.         GOTO 2085
  2220.      IF LEN(B$) > L THEN _
  2221.         CALL QTPUT (STR$(L) + " Chars. max",1 ) : _
  2222.         GOTO 2085
  2223.      IF L = 15 AND LEFT$(B$,1) = "!" THEN _
  2224.         CALL QTPUT ("Password can't begin with '!'",1) : _
  2225.         GOTO 2085
  2226.      RETURN
  2227. '
  2228. ' **  PASSWORD PROTECT MESSAGE (USERS WITH PASSWORD AND SYSOP CAN READ) **
  2229. '
  2230. 2088 A$ = "Receiver(s) Must KNOW PASSWORD TO READ msg.  Use password (Y/[N])"
  2231.      GOSUB 2093
  2232.      IF NOT YES THEN _
  2233.         GOTO 2070
  2234.      L = 14
  2235.      A1$ = "!"
  2236.      GOSUB 2085
  2237.      CALL ALLCAPS (B$)
  2238.      GOTO 2092
  2239. '
  2240. ' ** MAKE MESSAGE KILL PROTECTED (ONLY SENDER, ADDRESSEE AND SYSOP CAN KILL) **
  2241. '
  2242. 2090 L = 15
  2243.      A1$ = ""
  2244.      B$ = "^KILL^"
  2245. 2092 MESSAGE.PASSWORD$ = A1$ + _
  2246.                          B$
  2247.      EXIT SUB
  2248. 2093 TURBO.KEY = -TURBO.KEY.USER
  2249. 2094 SUBROUTINE.PARAMETER = 1
  2250.      CALL TGET
  2251.      IF SUBROUTINE.PARAMETER = -1 THEN _
  2252.         EXIT SUB
  2253.      RETURN
  2254.      END SUB
  2255. ' $SUBTITLE: 'WHOCHECK - Checks whether user exists'
  2256. ' $PAGE
  2257. '
  2258. '  SUBROUTINE NAME    -- WHOCHECK
  2259. '
  2260. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2261. '                         WHO.FIND$                User to find
  2262. '
  2263. '  OUTPUT PARAMETERS  --  WHO.FOUND                Whether user found
  2264. '                         USER.NUM.FOUND           Record # of user
  2265. '
  2266. '  SUBROUTINE PURPOSE --  Validate that user record exists.  Sysop
  2267. '                         counted as found even if lack user record.
  2268. '
  2269. 2250 SUB WHOCHECK (WHO.FIND$,WHO.FOUND,USER.NUM.FOUND) STATIC
  2270.      USER.NUM.FOUND = 0
  2271.      IF (START.HASH <> 1 OR START.INDIV <> 0) THEN _
  2272.         WHO.FOUND = TRUE : _
  2273.         EXIT SUB
  2274.      WHO.FOUND = FALSE
  2275.      TO.SYSOP = (INSTR(WHO.FIND$,"SYSOP") > 0 OR _
  2276.                  INSTR(WHO.FIND$,SYSOP.PASSWORD.1$ + " " + SYSOP.PASSWORD.2$) > 0 )
  2277.      CALL OPENUSER (HIGHEST.USER.RECORD)
  2278.      FIELD 5, 128 AS USER.RECORD$
  2279.      IF TO.SYSOP THEN _
  2280.         X$ = SYSOP.PASSWORD.1$ + " " + SYSOP.PASSWORD.2$ _
  2281.      ELSE X$ = WHO.FIND$
  2282.      CALL FINDUSER (X$,TEMP.INDIV.VALUE$,START.HASH,LEN.HASH,_
  2283.                     START.INDIV,LEN.INDIV,HIGHEST.USER.RECORD,WHO.FOUND,_
  2284.                     USER.NUM.FOUND,SL)
  2285.      IF USER.FILE.INDEX > 0 THEN _
  2286.         GET 5, USER.FILE.INDEX
  2287.      IF NOT WHO.FOUND THEN _
  2288.         IF TO.SYSOP THEN _
  2289.            WHO.FOUND = TRUE _
  2290.         ELSE CALL QTPUT (WHO.FIND$ + " not active user",1)
  2291.      END SUB
  2292. ' $SUBTITLE: 'EDITALINE - Edits a line in a message'
  2293. ' $PAGE
  2294. '
  2295. '  SUBROUTINE NAME    -- EDITALINE
  2296. '
  2297. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2298. '                         L                        Line # to edit
  2299. '
  2300. '  OUTPUT PARAMETERS  --  A$(L)                    Edited line
  2301. '
  2302. '  SUBROUTINE PURPOSE --  Edit a line in a message.
  2303. '
  2304.      SUB EDITALINE (L) STATIC
  2305. 2620 A$ = "Line #" + _
  2306.           STR$(L) + _
  2307.           " is:" + _
  2308.           RETURN.LINE.FEED$ + _
  2309.           A$(L)
  2310.      SUBROUTINE.PARAMETER = 3
  2311.      CALL TPUT
  2312.      GOSUB 2695
  2313.      IF NOT EXPERT.USER THEN _
  2314.         CALL QTPUT ("Search & replace",1)
  2315.      A$ = "Search for" + _
  2316.           PRESS.ENTER.EXPERT$
  2317.      PARSE.OFF = TRUE
  2318.      SUBROUTINE.PARAMETER = 1
  2319.      GOSUB 2694
  2320.      IF Q = 0 THEN _
  2321.         EXIT SUB
  2322.      Y$ = LEFT$(B$,1)
  2323.      IF Y$ = RIGHT$(B$,1) THEN _
  2324.         IF LEN(B$) > 2 THEN _
  2325.            X = INSTR(2,B$,Y$) : _
  2326.            IF X < LEN(B$) THEN _
  2327.               IF Y$ < "0" OR (Y$ > "9" AND Y$ < "A") THEN _
  2328.                  B$ = MID$(B$,2,LEN(B$)-2) : _
  2329.                  X = X - 1 : _
  2330.                  GOTO 2622
  2331.      X = INSTR(B$,";")
  2332. 2622 IF X > 0 THEN _
  2333.         X$ = LEFT$(B$,X-1) : _
  2334.         Y$ = RIGHT$(B$,LEN(B$)-X) : _
  2335.         GOTO 2660
  2336.      X$ = B$
  2337.      A$ = "And replace by"
  2338.      PARSE.OFF = TRUE
  2339.      SUBROUTINE.PARAMETER = 1
  2340.      GOSUB 2694
  2341.      Y$ = B$
  2342. 2660 X = INSTR(1,A$(L),X$)
  2343.      IF X = 0 THEN _
  2344.         CALL QTPUT ("<" + X$ + "> not found in line" + STR$(L),1) : _
  2345.         GOTO 2620
  2346. 2670 FF = LEN(X$)
  2347.      JJ = LEN(Y$)
  2348.      IF FF = JJ THEN _
  2349.         MID$(A$(L),X) = Y$ : _
  2350.         GOTO 2620
  2351. 2690 DF$ = LEFT$(A$(L),X - 1)
  2352.      A$(L) = DF$ + _
  2353.              Y$ + _
  2354.              MID$(A$(L),X + FF)
  2355.      GOTO 2620
  2356. 2694 CALL TGET
  2357. 2695 IF SUBROUTINE.PARAMETER > -1 THEN _
  2358.         RETURN
  2359.      END SUB
  2360. ' $SUBTITLE: 'LINEEDIT  - subroutine to produce edited line'
  2361. ' $PAGE
  2362. '
  2363. '  SUBROUTINE NAME    -- LINEEDIT
  2364. '
  2365. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  2366. '                        BACK.ARROW$
  2367. '                        BACKSPACE$
  2368. '                        CARRIAGE.RETURN$
  2369. '                        LINE.FEED$
  2370. '                        LINEMES$          BUFFER SPACE TO USE FOR HOLDING LINE
  2371. '                        LOCAL.USER
  2372. '                        MAX.LEN           MAXIMUM LENGTH OF STRING TO INPUT
  2373. '                        MESSAGE.LINE      WHERE IN A$() TO PUT THE EDITED LINE
  2374. '                        RIGHT.MARGIN
  2375. '                        SNOOP
  2376. '                        STOP.INTERRUPTS
  2377. '                        WAIT.EXPIRED
  2378. '
  2379. '  OUTPUT PARAMETERS  -- A$(MESSAGE.LINE)  EDITED LINE
  2380. '
  2381. '  SUBROUTINE PURPOSE -- SUBROUTINE TO EDIT A LINE QUICKLY USING A MINIMUM OF
  2382. '                        STRING SPACE.
  2383. '
  2384.      SUB LINEEDIT (MESSAGE.LINE,MAX.LEN) STATIC
  2385. 3700 LSET LINEMES$ = A$(MESSAGE.LINE)
  2386.      COL = LEN(A$(MESSAGE.LINE))
  2387.      STOP.INTERRUPTS = TRUE
  2388.      XXX = MAX.LEN - 3
  2389.      WAIT.EXPIRED = FALSE
  2390. 3720 COL = COL + 1
  2391.      CALL SETABORT (AUTO.LOGOFF!, WAIT.BEFORE.DISCONNECT)
  2392. 3730 CALL FINDFUNC
  2393.      IF SUBROUTINE.PARAMETER < 0 THEN _
  2394.         EXIT SUB
  2395.      X$ = KEY.PRESSED$
  2396.      IF X$ = "" THEN _
  2397.         IF LOCAL.USER THEN _
  2398.            GOTO 3730 _
  2399.         ELSE GOTO 3732
  2400.      IF X$ = ESCAPE$ THEN _
  2401.         KEY.PRESSED$ = X$ : _
  2402.         EXIT SUB
  2403.      SEND.REMOTE = TRUE
  2404.      Z = INSTR(LINEEDIT.CHK$,X$)
  2405.      IF Z < 1 THEN _
  2406.         GOTO 3750 _
  2407.      ELSE IF Z > 4 THEN _
  2408.              GOTO 3870
  2409.      IF LOCAL.USER THEN _
  2410.         GOTO 3730
  2411. 3732 IF COMMPORT.STACK$ <> "" THEN _
  2412.         X$ = LEFT$(COMMPORT.STACK$,1) : _
  2413.         COMMPORT.STACK$ = RIGHT$(COMMPORT.STACK$,LEN(COMMPORT.STACK$)-1) : _
  2414.         GOTO 3738
  2415.      CALL EOFCOMM (CHAR%)
  2416.      IF CHAR% <> -1 THEN _
  2417.         GOTO 3736
  2418.      CALL FINDTIME (TI!)
  2419.      IF TI! > AUTO.LOGOFF! THEN _
  2420.         WAIT.EXPIRED = TRUE : _
  2421.         EXIT SUB
  2422. 3733 CALL CARRIER
  2423.      IF SUBROUTINE.PARAMETER THEN _
  2424.         EXIT SUB
  2425.      GOTO 3730
  2426. 3736 AUTO.LOGOFF! = TI! + WAIT.BEFORE.DISCONNECT
  2427. 3737 CALL GETCOM (X$)
  2428. 3738 SEND.REMOTE = REMOTE.ECHO
  2429. 3740 ON INSTR(LINEEDIT.CHK$,X$) GOTO 3730,3730,3730,3730,3870,3870,3870,3870,3870
  2430. 3750 IF SEND.REMOTE THEN _
  2431.         CALL PUTCOM(X$)
  2432.      CALL LPRNT (X$, 0)
  2433.      IF X$ = CARRIAGE.RETURN$ THEN _
  2434.         COL = COL - 1 : _
  2435.         GOTO 3850
  2436. 3770 IF COL > XXX THEN _
  2437.         IF X$ = " " THEN _
  2438.            CALL SKIPLINE (1) : _
  2439.            GOTO 3860
  2440. 3780 MID$(LINEMES$,COL) = X$
  2441.      IF COL < MAX.LEN THEN _
  2442.         GOTO 3720
  2443.      Z = COL
  2444. 3800 IF Z < 1 THEN _
  2445.         Z = COL-1 : _
  2446.         GOTO 3820
  2447.      IF MID$(LINEMES$,Z,1) = " " THEN _
  2448.         GOTO 3820
  2449.      Z = Z - 1
  2450.      GOTO 3800
  2451. 3820 IF (NOT REMOTE.ECHO) AND (NOT LOCAL.USER) THEN _
  2452.         CALL SKIPLINE (1) : _
  2453.         GOTO 3860
  2454.      COL = MAX.LEN - Z
  2455.      IF SNOOP THEN _
  2456.         IF POS(0) > COL THEN _
  2457.            LOCATE ,POS(0)-COL: _
  2458.            CALL LPRNT(STRING$(COL,32),0)
  2459. 3830 IF REMOTE.ECHO THEN _
  2460.         CALL PUTCOM (STRING$(COL,8) + STRING$(COL,32))
  2461. 3840 A$(MESSAGE.LINE) = LEFT$(LINEMES$,Z)
  2462.      A$(MESSAGE.LINE + 1) = MID$(LINEMES$,Z + 1,COL)
  2463.      CALL SKIPLINE (1)
  2464.      'SUBROUTINE.PARAMETER = 5
  2465.      'CALL TPUT
  2466.      GOTO 3891
  2467. 3850 IF SEND.REMOTE AND LINE.FEEDS THEN _
  2468.         CALL PUTCOM(LINE.FEED$)
  2469. 3860 A$(MESSAGE.LINE) = LEFT$(LINEMES$,COL)
  2470.      GOTO 3891
  2471. 3870 IF COL = 1 THEN _
  2472.         GOTO 3730
  2473.      COL = COL-2
  2474. 3880 CALL LPRNT(LOCAL.BACKSPACE$,0)
  2475. 3885 IF SEND.REMOTE THEN _
  2476.         CALL PUTCOM (BACKSPACE$)
  2477. 3890 GOTO 3720
  2478. 3891 CALL CARRIER
  2479.      END SUB
  2480. ' $SUBTITLE: 'KILLMSG - subroutine to delete messages'
  2481. ' $PAGE
  2482. '
  2483. '  SUBROUTINE NAME    -- KILLMSG
  2484. '
  2485. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2486. '                         MESSAGE.TO.KILL              MESSAGE NUMBER TO KILL
  2487. '                         ACTIVE.MESSAGES              NUMBER ACTIVE MESSAGES
  2488. '
  2489. '  OUTPUT PARAMETERS  --  NONE
  2490. '
  2491. '  SUBROUTINE PURPOSE --  TO KILL/DELETE OLD OR UNNECESSARY MESSAGES
  2492. '
  2493.      SUB KILLMSG (MESSAGE.TO.KILL,ACTIVE.MESSAGES) STATIC
  2494. '
  2495.      FIELD #1,128 AS MESSAGE.RECORD$
  2496.      QX = 1
  2497. 3955 IF QX > ACTIVE.MESSAGES THEN _
  2498.         A$ = "No such msg #" + _
  2499.              STR$(MESSAGE.TO.KILL) : _
  2500.         GOTO 4031
  2501.      IF M(QX,2) = MESSAGE.TO.KILL AND MESSAGE.TO.KILL => 1 THEN _
  2502.         GOTO 3970
  2503.      QX = QX + 1
  2504.      GOTO 3955
  2505. 3970 SUBROUTINE.PARAMETER = 3
  2506.      CALL FILELOCK
  2507.      GET 1,M(QX,1)
  2508.      IF SYSOP THEN _
  2509.         GOTO 4030
  2510. 3980 Z$ = MID$(MESSAGE.RECORD$,101,15)
  2511.      CALL TRIM (Z$)
  2512.      IF LEN(Z$) = 0 THEN _
  2513.         GOTO 4030
  2514. 3990 IF Z$ = "^READ^" OR Z$ = "^KILL^" THEN _
  2515.         IF INSTR(MESSAGE.RECORD$,ACTIVE.USER.NAME$) THEN _
  2516.            GOTO 4030 _
  2517.         ELSE MESSAGE.PASSWORD = TRUE : _
  2518.              ATTEMPTS.ALLOWED = 0 : _
  2519.              CALL QTPUT("Only sender & receiver can kill",1) : _
  2520.              GOTO 4031
  2521. 4000 IF LEFT$(Z$,1) = "!" THEN _
  2522.         Z$ = MID$(Z$,2)
  2523. 4010 PASSWORD.SAVE$ = Z$ + _
  2524.                       SPACE$(15 - LEN(Z$))
  2525.      ATTEMPTS.ALLOWED = 1
  2526.      MESSAGE.PASSWORD = TRUE
  2527.      CALL PASSWRD
  2528.      IF PASSWORD.FAILED THEN _
  2529.         GOTO 4031
  2530. 4030 LSET MESSAGE.RECORD$ = LEFT$(MESSAGE.RECORD$,115) + _
  2531.                             DELETED.MESSAGE$ + _
  2532.                             MID$(MESSAGE.RECORD$,117)
  2533.      PUT 1,LOC(1)
  2534.      A$ = "Killed Msg # " + _
  2535.           STR$(MESSAGE.TO.KILL)
  2536.      SUBROUTINE.PARAMETER = 4
  2537.      CALL FILELOCK
  2538.      SUBROUTINE.PARAMETER = 5
  2539.      CALL TPUT
  2540.      EXIT SUB
  2541. 4031 SUBROUTINE.PARAMETER = 4
  2542.      CALL TPUT
  2543.      END SUB
  2544. ' $SUBTITLE: 'SETTHREAD - Sets up the interface for threading'
  2545. ' $PAGE
  2546. '
  2547. '  SUBROUTINE NAME    -- SETTHREAD
  2548. '
  2549. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2550. '                          CURR.MSG.NUM          Current message number
  2551. '                          CURR.SUBJ$            Current message subject
  2552. '
  2553. '  OUTPUT PARAMETERS  --  B$()                   Search msg by string
  2554. '                         Q                      0 if thread cancelled
  2555. '
  2556. '  SUBROUTINE PURPOSE --  Find out how the caller wants to thread -
  2557. '                         i.e. search messages by matching subject -
  2558. '                         forward from current, back from current,
  2559. '                         or forward from top of messages
  2560. '
  2561.      SUB SETTHREAD (CURR.MSG.NUM,CURR.SUBJ$) STATIC
  2562.      IF Q > 1 THEN _
  2563.         Z$ = B$(2) : _
  2564.         GOTO 4657
  2565. 4656 A$ = "THREAD: +)forward, -)back, 1)from origin ([ENTER] quits)"
  2566.      TURBO.KEY = -TURBO.KEY.USER
  2567.      SUBROUTINE.PARAMETER = 1
  2568.      CALL TGET
  2569.      IF Q = 0 OR SUBROUTINE.PARAMETER = -1 THEN _
  2570.         EXIT SUB
  2571.      Z$ = B$(1)
  2572. 4657 Z$ = LEFT$(Z$,1)
  2573.      X = INSTR("+-1",Z$)
  2574.      IF X = 0 THEN _
  2575.         GOTO 4656
  2576.      B$(1) = "R"
  2577.      IF X = 1 THEN _
  2578.         CURR.MSG.NUM = CURR.MSG.NUM + 1 _
  2579.      ELSE IF X = 2 THEN _
  2580.              CURR.MSG.NUM = CURR.MSG.NUM - 1 _
  2581.           ELSE CURR.MSG.NUM = 1 : _
  2582.                Z$ = "+"
  2583.      B$(3) = MID$(STR$(CURR.MSG.NUM),2) + Z$
  2584.      IF LEN(CURR.SUBJ$) < 4 OR LEFT$(CURR.SUBJ$,3) <> "(R)" THEN _
  2585.         B$(2) = CURR.SUBJ$ _
  2586.      ELSE B$(2) = MID$(CURR.SUBJ$,4)
  2587.      B$(2) = CHR$(34) + B$(2) + CHR$(34)
  2588.      Q = 3
  2589.      END SUB
  2590. ' $SUBTITLE: 'REMNONALF - removes non-alpha characters from a string'
  2591. ' $PAGE
  2592. '
  2593. '  SUBROUTINE NAME    -- REMNONALF
  2594. '
  2595. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2596. '                              STRNG$                   String to check
  2597. '                              MIN.CHAR            Remove chars with this
  2598. '                                                   ASCII value or lower
  2599. '                              MAX.CHAR            Remove chars with this
  2600. '                                                   ASCII value or higher
  2601. '
  2602. '  OUTPUT PARAMETERS  --       STRNG$                   String returned
  2603. '  SUBROUTINE PURPOSE --  CALCULATE THE ELASPED TIME A USER HAS BEEN ON
  2604. '
  2605. 5100 SUB REMNONALF (STRNG$,MIN.CHAR,MAX.CHAR) STATIC
  2606.      LAST = LEN(STRNG$)
  2607.      J = 1
  2608.      WHILE J <= LAST
  2609.         K = ASC(MID$(STRNG$,J))
  2610.         IF K > MIN.CHAR AND K < MAX.CHAR THEN _
  2611.            J = J + 1 _
  2612.         ELSE STRNG$ = LEFT$(STRNG$,J - 1) + _
  2613.                       RIGHT$(STRNG$,LAST - J) : _
  2614.              LAST = LAST - 1
  2615.      WEND
  2616.      END SUB
  2617. ' $SUBTITLE: 'PAGELEN - Sets lines per page'
  2618. ' $PAGE
  2619. '
  2620. '  SUBROUTINE NAME    -- PAGELEN
  2621. '
  2622. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2623. '                         PAGE.LENGTH              Current page length
  2624. '
  2625. '  OUTPUT PARAMETERS  --  PAGE.LENGTH              New page length
  2626. '
  2627. '  SUBROUTINE PURPOSE --  Change default lines per page
  2628. '
  2629.      SUB PAGELEN STATIC
  2630. 5202 A$ = "CHANGE page length from" + _
  2631.           STR$(PAGE.LENGTH) + _
  2632.           " TO (0-255, 0=continuous)"
  2633.      SUBROUTINE.PARMETER = 5
  2634.      CALL TGET
  2635.      IF Q = 0 OR SUBROUTINE.PARAMETER = -1 THEN _
  2636.         CALL QTPUT ("No change",1) : _
  2637.         EXIT SUB
  2638. 5230 CALL CHECKINT (B$(Q))
  2639.      IF EC <> 0 THEN _
  2640.         GOTO 5202
  2641.      IF TESTED.INTEGER.VALUE < 0 OR _
  2642.         TESTED.INTEGER.VALUE > 255 THEN _
  2643.         GOTO 5202
  2644.      PAGE.LENGTH = TESTED.INTEGER.VALUE
  2645.      CALL QTPUT ("Set to" + STR$(PAGE.LENGTH),1)
  2646.      END SUB
  2647. ' $SUBTITLE: 'BAUD450 -- Changes 300 baud to 450'
  2648. ' $PAGE
  2649. '  SUBROUTINE NAME    -- BAUD450
  2650. '
  2651. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  2652. '                        BPS
  2653. '
  2654. '  OUTPUT PARAMETERS  -- BPS
  2655. '
  2656. '  SUBROUTINE PURPOSE -- ALLOW 300 BAUD MODEMS TO BUMP UP TO 450 BAUD
  2657. '
  2658.      SUB BAUD450 STATIC
  2659.      IF BPS <> -1 THEN _
  2660.         CALL QTPUT ("Sorry, only 300 baud can change speed",1) : _
  2661.         EXIT SUB
  2662.      IF FOSSIL THEN _
  2663.         CALL QTPUT ("Sorry, 450 baud NOT supported under FOSSIL",1) : _
  2664.         EXIT SUB
  2665. 5507 A$ = "Change to 450 baud (Y,[N])"
  2666.      TURBO.KEY = -TURBO.KEY.USER
  2667.      SUBROUTINE.PARAMETER = 1
  2668.      CALL TGET
  2669.      IF NOT YES THEN _
  2670.         EXIT SUB
  2671. 5510 CALL QTPUT ("Change your baud rate to 450",1)
  2672.      CALL DELAYIT (9)
  2673.      C = 0
  2674.      BPS = -2
  2675.      CALL SETBAUD
  2676.      A$ = " and then press [ENTER] until I respond"
  2677.      SUBROUTINE.PARAMETER = 9
  2678.      CALL TGET
  2679. 5530 C = C + 1
  2680.      CALL CARRIER
  2681.      IF SUBROUTINE.PARAMETER THEN _
  2682.         EXIT SUB
  2683.      IF C = 20 THEN _
  2684.         CALL UPDTCALR ("Baud change failed",1) : _
  2685.         BPS = -1 : _
  2686.         CALL SETBAUD : _
  2687.         EXIT SUB
  2688.      CALL DELAYIT (1)
  2689. 5535 CALL EOFCOMM (CHAR%)
  2690.      IF CHAR% = -1 THEN _
  2691.         GOTO 5530
  2692. 5536 CALL PUTCOM(A$)
  2693.      IF A$ = "" THEN _
  2694.         A$ = " "
  2695.      IF ASC(A$) = 13 THEN _
  2696.         GOTO 5540
  2697.      IF SUBROUTINE.PARAMETER = -1 THEN _
  2698.         EXIT SUB
  2699. 5537 GOTO 5530
  2700. 5540 A$ = "Changed to 450 baud"
  2701.      CALL QTPUT (A$,1)
  2702.      CALL UPDTCALR (A$,1)
  2703.      BPS = -2
  2704.      A$ = ""
  2705.      END SUB
  2706. ' $SUBTITLE: 'GETIME - subroutine to calculate elapsed time'
  2707. ' $PAGE
  2708. '
  2709. '  SUBROUTINE NAME    -- GETIME
  2710. '
  2711. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2712. '                         TIME.LOGGED.ON$
  2713. '
  2714. '  OUTPUT PARAMETERS  --  HH                     NUMBER OF HOURS ON
  2715. '                         MM                     NUMBER OF MINUTES ON
  2716. '                         SS                     NUMBER OF SECONDS ON
  2717. '
  2718. '  SUBROUTINE PURPOSE --  CALCULATE THE ELASPED TIME A USER HAS BEEN ON
  2719. '
  2720.      SUB GETIME STATIC
  2721. 9140 H = VAL(MID$(TIME.LOGGED.ON$,1,2))
  2722.      M = VAL(MID$(TIME.LOGGED.ON$,4,2))
  2723.      S = VAL(MID$(TIME.LOGGED.ON$,7,2))
  2724.      X$ = TIME$
  2725.      HH = VAL(MID$(X$,1,2))
  2726.      MM = VAL(MID$(X$,4,2))
  2727.      JJ = VAL(MID$(X$,7,2))
  2728.      IF S <= JJ THEN _
  2729.         SSS = JJ - S _
  2730.      ELSE SSS = 60 - (S - JJ) : _
  2731.           M = M + 1
  2732. 9150 IF M <= MM THEN _
  2733.         MMM = MM - M _
  2734.      ELSE MMM = 60 - (M - MM) : _
  2735.           H = H + 1
  2736. 9160 IF H <= HH THEN _
  2737.         HHH = HH - H _
  2738.      ELSE HHH = 24 - (H - HH)
  2739.      END SUB
  2740. ' $SUBTITLE: 'DEFAULTU - subroutine to update user defauts'
  2741. ' $PAGE
  2742. '
  2743. '  SUBROUTINE NAME    -- DEFAULTU
  2744. '
  2745. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2746. '                         AUTODOWNLOAD.DESIRED
  2747. '                         BOLD.TEXT$              Ansi bold (0 no, 1 yes)
  2748. '                         CHECK.BULLETIN.LOGON
  2749. '                         EXPERT.USER
  2750. '                         GR
  2751. '                         LAST.MESSAGE.READ
  2752. '                         LINE.FEEDS
  2753. '                         NULLS
  2754. '                         PAGE.LENGTH
  2755. '                         PROMPT.BELL
  2756. '                         REG.DATE$
  2757. '                         REQ.QUES.ANSWERED
  2758. '                         RIGHT.MARGIN
  2759. '                         SKIP.FILES.LOGON
  2760. '                         TIMES.LOGGED.ON
  2761. '                         UPPER.CASE
  2762. '                         USER.OPTIONS$
  2763. '                         USER.TEXT.COLOR          Ansi of color (31-37)
  2764. '                         USER.TRANSFER.DEFAULT$
  2765. '
  2766. '  OUTPUT PARAMETERS  --  USER.OPTONS$
  2767. '
  2768. '  SUBROUTINE PURPOSE --  TO UPDATE THE USER'S RECORD WITH THEIR OPTIONS
  2769. '  Meaning of graphics preference stored is as follows: where # is
  2770. '  value stored for the color.  E.g. if graphics perference for text
  2771. '  files is color, and preference for normal text is light yellow,
  2772. '  graphics preference stored is 38.  Colors are Red, Green, Yellow,
  2773. '  Blue, Purple, Cyan, and White.
  2774. '
  2775. '             normal                  bold
  2776. ' Graphics R  G  Y  B  P  C  W    R  G  Y  B  P  C  W
  2777. '   none  30 33 36 39 42 45 48 | 51 54 57 60 63 66 69
  2778. '   ansi  31 34 37 40 43 46 49 | 52 55 58 61 64 67 70
  2779. '  color  32 35 38 41 44 47 50 | 53 56 59 62 65 68 71
  2780. '
  2781.      SUB DEFAULTU STATIC
  2782. 9600 A =        -PROMPT.BELL           -2 * EXPERT.USER _
  2783.             -4 * NULLS                 -8 * UPPER.CASE _
  2784.            -16 * LINE.FEEDS           -32 * CHECK.BULLETIN.LOGON _
  2785.            -64 * SKIP.FILES.LOGON    -128 * AUTODOWNLOAD.DESIRED _
  2786.           -256 * REQ.QUES.ANSWERED   -512 * MAIL.WAITING _
  2787.          -1024 * (NOT HIGHLIGHT.OFF)-2048 * TURBO.KEY.USER
  2788.      X = 3*USER.TEXT.COLOR - 63 + 21*VAL(BOLD.TEXT$) + GR
  2789.      IF X < 1 OR X > 255 THEN _
  2790.         X = 48
  2791.      LSET USER.OPTIONS$ = _
  2792.         MKI$(TIMES.LOGGED.ON) + _
  2793.         MKI$(LAST.MESSAGE.READ) + _
  2794.         USER.TRANSFER.DEFAULT$ + _
  2795.         CHR$(X) + _
  2796.         MKI$(RIGHT.MARGIN) + _
  2797.         MKI$(A) + _
  2798.         REG.DATE$ + _
  2799.         CHR$(PAGE.LENGTH) + _
  2800.         ECHOER$
  2801.      END SUB
  2802. ' $SUBTITLE: 'WHOSON - subroutine to display who is on'
  2803. ' $PAGE
  2804. '
  2805. '  SUBROUTINE NAME    -- WHOSON
  2806. '
  2807. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2808. '                         NUM.NODES                   # of nodes to check
  2809. '                         ACTIVE.MESSAGE.FILE$        Current message file
  2810. '                         ORIG.MESSAGE.FILE$          Main msg file
  2811. '
  2812. '  OUTPUT PARAMETERS  --  None
  2813. '
  2814. '  SUBROUTINE PURPOSE --  To display who is on each node.
  2815. '
  2816. 9801 SUB WHOSON (NUM.NODES) STATIC
  2817.      A1$ = ACTIVE.MESSAGE.FILE$
  2818.      ACTIVE.MESSAGE.FILE$ = ORIG.MESSAGE.FILE$
  2819.      CALL OPENMSG
  2820.      FIELD 1, 128 AS MESSAGE.RECORD$
  2821.      FOR NODE.INDEX = 2 TO NUM.NODES + 1
  2822.         GET 1,NODE.INDEX
  2823.         A$ = FG.1$ + "Node" + _
  2824.              STR$(NODE.INDEX - 1) + FG.2$
  2825.         REC.INDEX = VAL(MID$(MESSAGE.RECORD$,44,2))
  2826.         IF REC.INDEX = 0 THEN _
  2827.            REC.INDEX = -1
  2828.         AX$ = MID$("      300  450 1200 2400 4800 960019200",(-5 * REC.INDEX ),5) + _
  2829.               " BAUD: "
  2830.         IF MID$(MESSAGE.RECORD$,55,2) = "-1" AND NOT SYSOP THEN _
  2831.            Y$ = "SYSOP" + SPACE$(21) _
  2832.         ELSE Y$ = MID$(MESSAGE.RECORD$,1,26)
  2833.         AX$ = AX$ + FG.3$ + Y$
  2834.         IF MID$(MESSAGE.RECORD$,40,2) <> "-1" THEN _
  2835.            AX$ = AX$ + FG.4$ + MID$(MESSAGE.RECORD$,93,22)
  2836.         IF MID$(MESSAGE.RECORD$,57,1) = "A" THEN _
  2837.            A$ = A$ + "  Online at " + _
  2838.                 AX$ _
  2839.         ELSE IF NOT SYSOP THEN _
  2840.                 A$ = A$ + _
  2841.                      " Waiting for next caller" _
  2842.              ELSE A$ = A$ + _
  2843.                        " Offline at " + _
  2844.                        AX$
  2845.         CALL QTPUT (A$,1)
  2846.      NEXT
  2847.      ACTIVE.MESSAGE.FILE$ = A1$
  2848.      END SUB
  2849. ' $SUBTITLE: 'RECOVMSG - subroutine to recover deleted messages'
  2850. ' $PAGE
  2851. '
  2852. '  SUBROUTINE NAME    -- RECOVMSG
  2853. '
  2854. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2855. '                         MESSAGE.TO.RECOVER          MESSAGE NUMBER TO RECOVER
  2856. '                         FIRST.MESSAGE.RECORD        RECORD # FOR FIRST MSG
  2857. '
  2858. '  OUTPUT PARAMETERS  --  ACTION.FLAG                 SET TO 0 IF ERROR
  2859. '                                                     SET TO -1 IF NO ERROR
  2860. '
  2861. '  SUBROUTINE PURPOSE --  TO RECOVER DELETED MESSAGES.  NOTE THAT THIS IS ONLY
  2862. '                         POSSIBLE IF YOU HAVE NOT COMPRESSED YOUR MESSAGE FILE
  2863. '                         USING CONFIG.
  2864.       SUB RECOVMSG (MESSAGE.TO.RECOVER,FIRST.MESSAGE.RECORD,ACTION.FLAG) STATIC
  2865.       FIELD #1,128 AS MESSAGE.RECORD$
  2866. 10410 MESSAGE.RECORD = FIRST.MESSAGE.RECORD
  2867.       SUBROUTINE.PARAMETER = 5
  2868.       CALL TPUT
  2869. 10420 GET 1,MESSAGE.RECORD
  2870.       NUMBER.RECORDS.IN.MESSAGE = VAL(MID$(MESSAGE.RECORD$,117,4))
  2871.       IF NUMBER.RECORDS.IN.MESSAGE < 1 THEN _
  2872.          A$ = "USE CONFIG TO REPAIR YOUR MESSAGE FILE" : _
  2873.          GOTO 10485
  2874.       IF MESSAGE.RECORD => NEXT.MESSAGE.RECORD THEN _
  2875.          A$ = "No Msg #" + _
  2876.               STR$(MESSAGE.TO.RECOVER) : _
  2877.          GOTO 10485
  2878. 10440 IF VAL(MID$(MESSAGE.RECORD$,2,4)) <> MESSAGE.TO.RECOVER THEN _
  2879.          MESSAGE.RECORD = MESSAGE.RECORD + NUMBER.RECORDS.IN.MESSAGE : _
  2880.          GOTO 10420
  2881. 10450 IF INSTR(MESSAGE.RECORD$,DELETED.MESSAGE$) <> 0 THEN _
  2882.          SUBROUTINE.PARAMETER = 3 : _
  2883.          CALL TPUT : _
  2884.          LSET MESSAGE.RECORD$ = LEFT$(MESSAGE.RECORD$,115) + _
  2885.                                 ACTIVE.MESSAGE$ + _
  2886.                                 MID$(MESSAGE.RECORD$,117) : _
  2887.          PUT 1,LOC(1) : _
  2888.          SUBROUTINE.PARAMETER = 4 : _
  2889.          CALL TPUT : _
  2890.          A$ = "Restored Msg #" + _
  2891.               STR$(MESSAGE.TO.RECOVER) : _
  2892.          ACTION.FLAG = TRUE : _
  2893.          GOTO 10485
  2894. 10480 A$ = "Msg #" + _
  2895.            STR$(MESSAGE.TO.RECOVER) + _
  2896.            " not Dead"
  2897. 10485 CALL QTPUT (A$,1)
  2898.       END SUB
  2899. ' $SUBTITLE: 'UPDATEU -- Update the users record at logoff'
  2900. ' $PAGE
  2901. '  SUBROUTINE NAME    -- UPDATEU
  2902. '
  2903. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  2904. '                        ADJUSTED.SECURITY
  2905. '                        CURRENT.DATE$
  2906. '                        DOWNLOADS
  2907. '                        ELAPSED.TIME
  2908. '                        LIST.DIRECTORY
  2909. '                        MAIN.USER.FILE.INDEX
  2910. '                        SECONDS.PER.SESSION!
  2911. '                        UPLOADS
  2912. '                        USER.SECURITY.LEVEL
  2913. '
  2914. '  OUTPUT PARAMETERS  -- ELAPSED.TIME$
  2915. '                        LIST.NEW.DATE$
  2916. '                        SECURITY.LEVEL$
  2917. '                        USER.DOWNLOADS$
  2918. '                        USER.UPLOADS$
  2919. '
  2920. '  SUBROUTINE PURPOSE -- UPDATE THE USER RECORD FOR THE USER WHEN THE USER
  2921. '                        EXITS RBBS-PC.
  2922. '
  2923.       SUB UPDATEU STATIC
  2924.       IF ACTIVE.USER.NAME$ = "" OR FIRST.NAME$ = "" THEN _
  2925.          EXIT SUB
  2926. 10600 CALL TIMEREMAIN (TIME.REMAINING!)
  2927.       Q! = ELAPSED.TIME + MINUTES.IN.DOORS + _
  2928.            ((SECONDS.PER.SESSION! - TIME.CREDITS!)/ 60) - _
  2929.            TIME.REMAINING!
  2930.       IF Q! < -32000 THEN _
  2931.          Q! = -32000 _
  2932.       ELSE IF Q! > 32000 THEN _
  2933.          Q! = 32000
  2934.       IF USER.FILE.INDEX < 1 THEN _
  2935.          GOTO 10607
  2936.       UPDATE.DEFAULTS = TRUE
  2937. 10602 SUBROUTINE.PARAMETER = 6
  2938.       CALL FILELOCK
  2939.       CALL OPENUSER (HIGHEST.USER.RECORD)
  2940.       FIELD 5,31 AS USER.NAME$, _
  2941.               15 AS PASSWORD$, _
  2942.                2 AS SECURITY.LEVEL$, _
  2943.               14 AS USER.OPTIONS$,  _
  2944.               24 AS CITY.STATE$, _
  2945.               3 AS MACHINE.TYPE$, _
  2946.               4 AS TODAY.DL$, _
  2947.               4 AS TODAY.BYTES$, _
  2948.               4 AS DL.BYTES$, _
  2949.               4 AS UL.BYTES$, _
  2950.               14 AS LAST.DATE.TIME.ON$, _
  2951.                3 AS LIST.NEW.DATE$, _
  2952.                2 AS USER.DOWNLOADS$, _
  2953.                2 AS USER.UPLOADS$, _
  2954.                2 AS ELAPSED.TIME$
  2955. 10604 GET 5,USER.FILE.INDEX
  2956.       IF UPDATE.DEFAULTS THEN _
  2957.          CALL DEFAULTU
  2958.       IF LIST.DIRECTORY THEN _
  2959.          LSET LIST.NEW.DATE$ = CHR$(VAL(MID$(CURRENT.DATE$,7,2))) + _
  2960.                                CHR$(VAL(MID$(CURRENT.DATE$,1,2))) + _
  2961.                                CHR$(VAL(MID$(CURRENT.DATE$,4,2)))
  2962. 10605 LSET USER.DOWNLOADS$ = MKI$(DOWNLOADS)
  2963.       LSET USER.UPLOADS$ = MKI$(UPLOADS)
  2964.       IF ENFORCE.UPLOAD.DOWNLOAD.RATIOS THEN _
  2965.          LSET TODAY.DL$ = MKS$(DL.TODAY!) : _
  2966.          LSET TODAY.BYTES$ = MKS$(BYTES.TODAY!) : _
  2967.          LSET DL.BYTES$ = MKS$(DLBYTES!) : _
  2968.          LSET UL.BYTES$ = MKS$(ULBYTES!)
  2969.       LSET ELAPSED.TIME$ = MKI$(Q!)
  2970.       IF ADJUSTED.SECURITY THEN _
  2971.          LSET SECURITY.LEVEL$ = MKI$(USER.SECURITY.LEVEL)
  2972.       PUT 5,USER.FILE.INDEX
  2973.       SUBROUTINE.PARAMETER = 8
  2974.       CALL FILELOCK
  2975.       IF ACTIVE.USER.FILE$ <> ORIG.USER.FILE$ THEN _
  2976.          ACTIVE.USER.FILE$ = ORIG.USER.FILE$ : _
  2977.          USER.FILE.INDEX = ORIG.USER.FILE.INDEX : _
  2978.          UPDATE.DEFAULTS = FALSE : _
  2979.          GOTO 10602
  2980. 10607 IF EXIT.TO.DOORS THEN _
  2981.          EXIT SUB
  2982.       IF MAX.PER.DAY <= 0 THEN _
  2983.          X = MINUTES.PER.SESSION! _
  2984.       ELSE X = (MAX.PER.DAY - Q!) : _
  2985.            X = -(X > 0) * X
  2986.       CALL QTPUT (STR$(X)+" min left for next call today",1)
  2987.       CALL QTPUT(FIRST.NAME$ + ", Thanks and please call again!",1)
  2988.       IF NOT HIGHLIGHT.OFF THEN _
  2989.          CALL QTPUT (COLOR.RESET$,1)
  2990.       CALL DELAYIT (8 + BPS)
  2991.       END SUB
  2992. ' $SUBTITLE: 'DOSEXIT -- Setup to exit to DOS for SYSOP'
  2993. ' $PAGE
  2994. '  SUBROUTINE NAME    -- DOSEXIT
  2995. '
  2996. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  2997. '                        COM.PORT$
  2998. '                        DOORS.TERMINAL.TYPE
  2999. '                        MULTI.LINK.PRESENT
  3000. '                        RBBS.BAT$
  3001. '                        REDIRECT.IO.METHOD
  3002. '                        USE.DEVICE.DRIVER$
  3003. '
  3004. '  OUTPUT PARAMETERS  -- Q                    NUMBER OF LINES TO WRITE OUT TO
  3005. '                                             RCTTY.BAT$
  3006. '                        B$()                 LINES TO WRITE OUT TO RCTTY.BAT$
  3007. '
  3008. '  SUBROUTINE PURPOSE -- SET UP B$() AND Q IN ORDER TO CALL "RBBSEXIT" AND
  3009. '                        EXIT TO DOS FOR THE REMOTE RBBS-PC SYSOP
  3010. '
  3011.       SUB DOSEXIT STATIC
  3012. 10934 IF MULTI.LINK.PRESENT AND _
  3013.          DOORS.TERMINAL.TYPE > 0 THEN _
  3014.          FF = 0 : _
  3015.          GOTO 10950
  3016.       A$(1) = "ECHO OFF"
  3017.       IF USE.DEVICE.DRIVER$ <> "" THEN _
  3018.          PORT$ = USE.DEVICE.DRIVER$ _
  3019.       ELSE PORT$ = "COM" + RIGHT$(COM.PORT$,1)
  3020.       IF REDIRECT.IO.METHOD THEN _
  3021.          FF = 5 : _
  3022.          A$(2) = "CTTY " + _
  3023.                  PORT$ : _
  3024.          A$(3) = DISK.FOR.DOS$ + _
  3025.                  "COMMAND" : _
  3026.          A$(4) = "CTTY CON" : _
  3027.          A$(5) = RBBS.BAT$ _
  3028.       ELSE FF = 3 : _
  3029.            A$(2) = DISK.FOR.DOS$ + _
  3030.                    "COMMAND >" + _
  3031.                    PORT$ + _
  3032.                    " <" + _
  3033.                    PORT$ : _
  3034.            A$(3) = RBBS.BAT$
  3035. 10950 SUBROUTINE.PARAMETER = 1
  3036.       CALL AMORPM
  3037.       CALL UPDTCALR ("Exited to DOS at " + TIM$,2)
  3038.       CALL QTPUT("RBBS-PC " + VERSION.ID$,1)
  3039.       CALL QTPUT("SYSOP in Remote Console Mode",1)
  3040.       CALL RBBSEXIT (A$(),FF)
  3041.       END SUB
  3042. ' $SUBTITLE: 'WORDINFILE -- Searches a file to find a word'
  3043. ' $PAGE
  3044. '  SUBROUTINE NAME    -- WORDINFILE
  3045. '
  3046. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  3047. '                        FILNAME$      FILE TO SEARCH IN
  3048. '                        STRNG$        STRING TO SEARCH FOR
  3049. '
  3050. '  OUTPUT PARAMETERS  -- INFILE        WHETHER STRING FOUND IN FILE
  3051. '
  3052. '  SUBROUTINE PURPOSE -- SEARCHES FOR "STRNG$" IN FILE "FILNAME$."  USED TO
  3053. '                        LIMIT DOORS AND QUESTIONNAIRES TO THOSE SPECIFIED
  3054. '                        IN THEIR MENU FILES.  THE "STRNG$" IS CAPITALIZED
  3055. '                        BUT NOT THE LINES IN THE FILE, SO MUST BE EXACT
  3056. '                        CASE-SENSITIVE MATCH TO BE FOUND.  THE ONLY CHARACTER
  3057. '                        THAT CAN IMMEDIATELY PROCEED OR END A NAME TO BE
  3058. '                        FOUND MUST BE A BLANK.
  3059. '
  3060.       SUB WORDINFILE (FILNAME$,STRNG$,INFILE) STATIC
  3061. 10976 INFILE = FALSE
  3062.       CALL FINDIT (FILNAME$)
  3063.       IF NOT OK THEN _
  3064.          EXIT SUB
  3065.       X = 0
  3066.       CALL ALLCAPS (STRNG$)
  3067.       WHILE NOT EOF(2) AND X < 1
  3068.          LINE INPUT #2,A$
  3069.          Y = 1
  3070. 10978    X = INSTR(Y,A$,STRNG$)
  3071.          IF X < 1 THEN _
  3072.             GOTO 10980
  3073.          Y = X + 1
  3074.          IF X > 1 THEN _
  3075.             IF MID$(A$,X - 1,1) <> " " THEN _
  3076.                X = 0
  3077.          IF X > 0 THEN _
  3078.             L = LEN(STRNG$) : _
  3079.             IF LEN(A$) => (X + L) THEN _
  3080.                IF MID$(A$,X + L,1) <> " " THEN _
  3081.                   X = 0
  3082.          IF X = 0 THEN _
  3083.             GOTO 10978
  3084. 10980 WEND
  3085.       CLOSE 2
  3086.       INFILE = (X > 0)
  3087.       END SUB
  3088. ' $SUBTITLE: 'DOOREXIT -- Setup to exit to a "door"'
  3089. ' $PAGE
  3090. '  SUBROUTINE NAME    -- DOOREXIT
  3091. '
  3092. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  3093. '                        MULTI.LINK.PRESENT
  3094. '                        NODE.ID$
  3095. '                        RBBS.BAT$
  3096. '                        Z$
  3097. '
  3098. '  OUTPUT PARAMETERS  -- Q                    NUMBER OF LINES TO WRITE OUT TO
  3099. '                                             RCTTY.BAT$
  3100. '                        B$()                 LINES TO WRITE OUT TO RCTTY.BAT$
  3101. '
  3102. '  SUBROUTINE PURPOSE -- SET UP B$() AND Q IN ORDER TO CALL "EXITRBBS" AND
  3103. '                        EXIT RBBS-PC TO INVOKE ANTOHER PROGRAM
  3104. '
  3105.       SUB DOOREXIT STATIC
  3106.       IF Z$ = "" OR _
  3107.          Z$ = "NONE" THEN _
  3108.          EXIT SUB
  3109.       CALL FINDIT (Z$)
  3110.       IF NOT OK THEN _
  3111.          A$ = "Missing door program" : _
  3112.          CALL UPDTCALR (A$ + " " + Z$,1) : _
  3113.          SNOOP = TRUE : _
  3114.          CALL LPRNT (A$,1) : _
  3115.          EXIT SUB
  3116. 10987 A$(1) = DISK.FOR.DOS$ + _
  3117.               "COMMAND /C " + _
  3118.               Z$ + _
  3119.               " " + _
  3120.               NODE.ID$
  3121.       A$(2) = RBBS.BAT$
  3122.       Z$ = LEFT$(Z$,LEN(Z$) - 4)
  3123.       IF TRANSFER.FUNCTION = 3 THEN _
  3124.          Y$ = "Registration" : _
  3125.       ELSE Y$ = Z$
  3126.       A$ = Y$ + _
  3127.            " door opened at " + _
  3128.            TIME$ + _
  3129.            " on " + _
  3130.            DATE$
  3131.       SUBROUTINE.PARAMETER = 5
  3132.       CALL TPUT
  3133.       CALL UPDTCALR (Z$ + " door opened!",2)
  3134.       CLOSE 2
  3135.       OPEN "O",2,"DORINFO" + _
  3136.                  NODE.FILE.ID$ + _
  3137.                  ".DEF"
  3138.       PRINT #2,RBBS.NAME$
  3139.       PRINT #2,SYSOP.FIRST.NAME$
  3140.       PRINT #2,SYSOP.LAST.NAME$
  3141.       PRINT #2,COM.PORT$
  3142.       B$ = MID$(BAUD.PARITY$,INSTR(BAUD.PARITY$," B"))
  3143.       PRINT #2,TALK.TO.MODEM.AT$;B$
  3144.       PRINT #2,NETWORK.TYPE
  3145.       IF GLOBAL.SYSOP THEN _
  3146.          PRINT #2,"SYSOP" : _
  3147.          PRINT #2,"" _
  3148.       ELSE PRINT #2,FIRST.NAME$ : _
  3149.            PRINT #2,LAST.NAME$
  3150.       PRINT #2,CITY.STATE$
  3151.       PRINT #2,GR
  3152.       PRINT #2,USER.SECURITY.LEVEL
  3153.       CALL TIMEREMAIN (TIME.REMAINING!)
  3154.       PRINT #2,INT(TIME.REMAINING!)
  3155.       PRINT #2,FOSSIL
  3156.       CALL RBBSEXIT (A$(),2)
  3157.       END SUB
  3158. ' $SUBTITLE: 'RBBSEXIT -- Setup to exit RBBS'
  3159. ' $PAGE
  3160. '  SUBROUTINE NAME    -- RBBSEXIT
  3161. '
  3162. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  3163. '                        LINE.ARA        Array of lines to write to batch file
  3164. '                        NUM.LINES       How many lines in array
  3165. '
  3166. '  OUTPUT PARAMETERS  -- RCTTY.BAT$
  3167. '
  3168. '  SUBROUTINE PURPOSE -- TO CREATE A BATCH FILE THAT CONTROL CAN BE PASSED TO
  3169. '                        AND TO EXIT RBBS-PC WHILE STILL KEEPING CARRIER UP
  3170. '
  3171.       SUB RBBSEXIT (LINE.ARA$(1),NUM.LINES) STATIC
  3172. 10992 CLOSE 2
  3173.       IF NUM.LINES = 0 THEN _
  3174.          GOTO 10994
  3175.       OPEN "O",2,RCTTY.BAT$
  3176.       FOR I = 1 TO NUM.LINES
  3177.          IF LINE.ARA$(I) <> "" THEN _
  3178.             PRINT #2,LINE.ARA$(I)
  3179.       NEXT
  3180.       CLOSE 2
  3181. 10994 CLOSE 3
  3182.       EXIT.TO.DOORS = TRUE
  3183.       IF NOT FOSSIL THEN _
  3184.          OUT MODEM.CONTROL.REGISTER,INP(MODEM.CONTROL.REGISTER) OR 1
  3185.       IF NOT PRIVATE.DOOR THEN _
  3186.          CALL MLINIT (2)
  3187. 10996 CALL UPDATEU
  3188.       CALL GETIME
  3189.       CALL UPDATEC
  3190.       CALL SAVEPROF (1)
  3191.       IF NUM.LINES = 0 THEN _
  3192.          EXIT SUB
  3193.       CALL DELAYIT (9 + BPS)
  3194.       IF FOSSIL THEN _
  3195.          CALL FOSEXIT(COMPORT%)
  3196.       SYSTEM
  3197.       END SUB
  3198. ' $SUBTITLE: 'SETSECT -- Setup section prompts'
  3199. ' $PAGE
  3200. '  SUBROUTINE NAME    -- SETSECT         Doug Azzarito
  3201. '
  3202. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  3203. '                        MENU.INDEX      2 = user is in MAIN section
  3204. '                                        3 = user is in FILE section
  3205. '                                        4 = user is in UTIL section
  3206. '                                        6 = user is in LIBR section
  3207. '
  3208. '  OUTPUT PARAMETERS  -- SECTION$        4 character section name
  3209. '                        ACTIVE.MENU$    1 character section name
  3210. '                        SECTION.PROMPT$ Section name (if SHOW.SECTION config)
  3211. '                        COMMAND.PROMPT$ Command input prompt string
  3212. '                        SECTION.OPTS$   List of options valid in this sect
  3213. '                        INVALID.OPTS$   List of options invalid in this sect
  3214. '                        SUB.SECTION     Index into security array for section
  3215. '
  3216. '  SUBROUTINE PURPOSE -- TO BUILD THE PROMPT STRINGS FOR THE CURRENT SECTION
  3217. '
  3218.       SUB SETSECT STATIC
  3219. 12000 ON MENU.INDEX GOTO 12001, 12010,12005,12020,12001,12015
  3220. 12001 EXIT SUB
  3221. 12005 LSET SECTION$ = "FILE"
  3222.       SECTION.OPTS$ = FILE.OPTS$
  3223.       INVALID.OPTS$ = INVALID.FILE.OPTS$
  3224.       SUB.SECTION = BEG.FILE
  3225.       GOTO 12025
  3226. 12010 LSET SECTION$ = "MAIN"
  3227.       SECTION.OPTS$ = MAIN.OPTS$
  3228.       INVALID.OPTS$ = INVALID.MAIN.OPTS$
  3229.       SUB.SECTION = BEG.MAIN
  3230.       GOTO 12025
  3231. 12015 LSET SECTION$ = "LIBR"
  3232.       SECTION.OPTS$ = LIBRARY.OPTS$
  3233.       INVALID.OPTS$ = INVALID.LIBRARY.OPTS$
  3234.       SUB.SECTION = BEG.LIBRARY
  3235.       GOTO 12025
  3236. 12020 LSET SECTION$ = "UTIL"
  3237.       SECTION.OPTS$ = UTIL.OPTS$
  3238.       INVALID.OPTS$ = INVALID.UTIL.OPTS$
  3239.       SUB.SECTION = BEG.UTIL
  3240. 12025 ACTIVE.MENU$ = LEFT$(SECTION$,1)
  3241.       IF SHOW.SECTION THEN _
  3242.          SECTION.PROMPT$ = SECTION$ _
  3243.       ELSE SECTION.PROMPT$ = "Your"
  3244.       IF COMMANDS.IN.PROMPT=0 THEN _
  3245.           SECTION.OPTS$ = ""
  3246.       COMMAND.PROMPT$ = SECTION.PROMPT$ + _
  3247.                         " command" + _
  3248.                         SECTION.OPTS$
  3249.       END SUB
  3250. ' $SUBTITLE: 'UNTILRIGHT - subroutine to ask question until answer okay'
  3251. ' $PAGE
  3252. '
  3253. '  SUBROUTINE NAME    -- UNTILRIGHT
  3254. '
  3255. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  3256. '                        QUES$         QUESTION TO BE ASKED THE USER
  3257. '                        ANS$          LOCATION TO STORE THE ANSWER
  3258. '                        MIN.LEN       MINIMUM LENGTH OF ANSWER
  3259. '                        MAX.LEN       MAX LENGTH OF ANSWER
  3260. '
  3261. '  OUTPUT PARAMETERS  -- ANS$          RESPONSE TO THE QUESTION WHICH THE
  3262. '                                      CALLERS SAYS IS CORRECT
  3263. '
  3264. '  SUBROUTINE PURPOSE -- SUBROUTINE TO ASK A USER A QUESTION UNTIL THE CALLER
  3265. '                        RESPONDS THAT THE ANSWER IS CORRECT
  3266. '
  3267.       SUB UNTILRIGHT (QUES$,ANS$,MIN.LEN,MAX.LEN) STATIC
  3268. 12880 SUBROUTINE.PARAMETER = 1
  3269.       A$ = QUES$
  3270.       CALL TGET
  3271.       IF SUBROUTINE.PARAMETER = -1 THEN _
  3272.          GOTO 12882
  3273.       IF Q = 0 THEN _
  3274.          GOTO 12880
  3275.       IF LEN(B$(1)) > MAX.LEN THEN _
  3276.          CALL QTPUT (STR$(MAX.LEN) + " chars max",1) : _
  3277.          GOTO 12880_
  3278.       ELSE IF LEN(B$(1)) < MIN.LEN THEN _
  3279.               CALL QTPUT (STR$(MIN.LEN) + " chars min",1) : _
  3280.               GOTO 12880
  3281.       ANS$ = B$(1)
  3282.       A$ = B$(1) + _
  3283.            ", right ([Y],N)"
  3284.       TURBO.KEY = -TURBO.KEY.USER
  3285.       SUBROUTINE.PARAMETER = 1
  3286.       CALL TGET
  3287.       IF SUBROUTINE.PARAMETER = -1 THEN _
  3288.          GOTO 12882
  3289.       IF NO THEN _
  3290.          GOTO 12880
  3291.       CALL ALLCAPS (ANS$)
  3292.       EXIT SUB
  3293. 12882 ANS$ = "GUEST"
  3294.       END SUB
  3295. ' $SUBTITLE: 'LOGERROR - subroutine to log errors to CALLERS file'
  3296. ' $PAGE
  3297. '
  3298. '  SUBROUTINE NAME    -- LOGERROR
  3299. '
  3300. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  3301. '                               ERR           ERROR NUMBER DETECTED BY BASIC
  3302. '                               ERL           LAST LINE NUMBER ENCOUNTERED
  3303. '                                             PRIOR TO ENCOUNTERNING ERROR
  3304. '
  3305. '  OUTPUT PARAMETERS  -- NONE
  3306. '
  3307. '  SUBROUTINE PURPOSE -- TO SET UP A STRING TO WRITE TO THE CALLERS LOG
  3308. '                        INDICATING THE DATE, TIME, ERROR, AND ERROR LINE
  3309. '
  3310.       SUB LOGERROR STATIC
  3311. 13660 IX = ERR
  3312.       IF ERR < 1 THEN _
  3313.          IX = EC
  3314.       CALL UPDTCALR("+++ Error " + _
  3315.            STR$(IX) + _
  3316.            " line " + _
  3317.            STR$(ERL) + _
  3318.            " at " + _
  3319.            TIME$ + _
  3320.            " on " + _
  3321.            DATE$,2)
  3322.       END SUB
  3323. '
  3324. ' $SUBTITLE: 'CHECKRATIO - subroutine to print ul/dl ratio'
  3325. ' $PAGE
  3326. '
  3327. '  SUBROUTINE NAME    -- CHECKRATIO
  3328. '
  3329. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  3330. '                          TELL.USER          TELL USER THEIR RATIO
  3331. '                          DOWNLOADS          FILES DOWNLOADED
  3332. '                          DLBYTES!           BYTES DOWNLOADED
  3333. '                          UPLOADS            FILES UPLOADED
  3334. '                          ULBYTES!           BYTES UPLOADED
  3335. '
  3336. '  OUTPUT PARAMETERS  -- OK  - IF IT IS OK FOR THE USER TO DOWNLOAD
  3337. '
  3338. '  SUBROUTINE PURPOSE -- TO PRINT THE USERS UPLOAD TO DOWNLOAD RATIO
  3339. '                        AND TO DETERMINE IF THE USERS HAS VIOLATED
  3340. '                        THEIR UPLOAD TO DOWNLOAD RESTRICTION
  3341. '
  3342. '
  3343.       SUB CHECKRATIO (TELL.USER) STATIC
  3344.       OK = TRUE
  3345. 20096 IF NOT ENFORCE.UPLOAD.DOWNLOAD.RATIOS THEN _
  3346.          GOTO 20110
  3347.       IF RATIO.RESTRICTION# = 0 THEN _
  3348.          GOTO 20110
  3349. '
  3350. ' DETERMINE METHOD OF RATIO CHECKING TO BE PERFORMED
  3351. '
  3352.       IF BYTE.METHOD = 1 OR BYTE.METHOD = 3 THEN _
  3353.          METHOD$ = "Bytes" : _
  3354.          UL.WORK# = ULBYTES! : _
  3355.          DL.WORK# = DLBYTES!
  3356.       IF BYTE.METHOD = 0 OR BYTE.METHOD = 2 THEN _
  3357.          METHOD$ = "Files" : _
  3358.          UL.WORK# = UPLOADS : _
  3359.          DL.WORK# = DOWNLOADS
  3360.       IF BYTE.METHOD = 2 THEN _
  3361.          TODAY# = RATIO.RESTRICTION# - DL.TODAY!
  3362.       IF BYTE.METHOD = 3 THEN _
  3363.          TODAY# = RATIO.RESTRICTION# - BYTES.TODAY! - NUM.DNLD.BYTS!
  3364. '
  3365.       RATIO# = INT(DL.WORK# / 1)
  3366.       RATIO.SUFFIX$ = ":0"
  3367.       IF UL.WORK# > 0 THEN _
  3368.          RATIO# = INT(DL.WORK# / UL.WORK#) : _
  3369.          RATIO.SUFFIX$ = ":1"
  3370.       IF BYTE.METHOD < 2 THEN _
  3371.          A$ = METHOD$ + " Downloaded:" + STR$(DL.WORK#) + _
  3372.               " Uploaded:" + _
  3373.               STR$(UL.WORK#) + _
  3374.               " Ratio:" + _
  3375.               STR$(RATIO#) + _
  3376.               RATIO.SUFFIX$ : _
  3377.          SUBROUTINE.PARAMETER = 5 : _
  3378.          CALL TPUT
  3379.       IF BYTE.METHOD > 1 THEN _
  3380.          A$ = "Today Downloaded Files: " + STR$(DL.TODAY!) + _
  3381.               " Bytes:" + STR$(BYTES.TODAY!) : _
  3382.          SUBROUTINE.PARAMETER = 5 : _
  3383.          CALL TPUT : _
  3384.          CALL SKIPLINE (1)
  3385. '
  3386. '  CHECK TO SEE IF THE USER HAS VIOLATED THEIR UL/DL RESTRICTION
  3387. '
  3388. 20100 IF NOT (RATIO.RESTRICTION# > 0 AND TELL.USER) THEN _
  3389.          EXIT SUB
  3390.       IF BYTE.METHOD <= 1 THEN _
  3391.          GOTO 20105
  3392.       IF TODAY# <= 0 THEN _
  3393.          A$ = "Sorry, Daily download limit of" + _
  3394.               STR$(RATIO.RESTRICTION#) + " " + _
  3395.               METHOD$ + " Reached" : _
  3396.          OK = FALSE _
  3397.       ELSE A$ = "Download balance remaining:" + _
  3398.                 STR$(RATIO.RESTRICTION#) + _
  3399.                 " " + _
  3400.                 METHOD$ : _
  3401.            OK = TRUE
  3402.       SUBROUTINE.PARAMETER = 5
  3403.       CALL TPUT
  3404.       CALL SKIPLINE(1)
  3405.       EXIT SUB
  3406. '
  3407. 20105 IF RATIO# >= RATIO.RESTRICTION# THEN _
  3408.          OK = FALSE : _
  3409.          A$ = "Sorry, DL/UL ratio of" + _
  3410.               STR$(RATIO.RESTRICTION#) + _
  3411.               ":1 " + _
  3412.               METHOD$ + " exceeded" : _
  3413.          SUBROUTINE.PARAMETER = 5 : _
  3414.          CALL TPUT : _
  3415.          A$ = "Minimum upload of" + _
  3416.               STR$(INT(((DL.WORK# - (UL.WORK# * RATIO.RESTRICTION#)) _
  3417.               / RATIO.RESTRICTION#) + 1)) + _
  3418.               + " " + METHOD$ + " required before may download" _
  3419.       ELSE A$ = "Balance remaining before upload required:" + _
  3420.                 STR$(INT((UL.WORK# * RATIO.RESTRICTION#)-DL.WORK#)) + _
  3421.                 " " + METHOD$
  3422.       SUBROUTINE.PARAMETER = 5
  3423.       CALL TPUT
  3424.       CALL SKIPLINE (1)
  3425. 20110 END SUB
  3426. ' $SUBTITLE: 'GETARC - subroutine to get what files to verbose list'
  3427. ' $PAGE
  3428. '
  3429. '  SUBROUTINE NAME    -- GETARC
  3430. '
  3431. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  3432. '                         Q                     NUMBER OF ENTRIES TYPED
  3433. '                         B$()                  ENTRIES TYPED
  3434. '
  3435. '  OUTPUT PARAMETERS  --
  3436. '
  3437. '  SUBROUTINE PURPOSE --  PROCESS THE V)ERBOSE ARC LIST COMMAND.
  3438. '                         TAKES WHAT USER TYPES AND TRIES TO LIST IT.
  3439. '
  3440.       SUB GETARC STATIC
  3441.       IF Q > 1 THEN _
  3442.          B = 2 : _
  3443.          GOTO 20142
  3444. 20141 A$ = "Enter ARCed file(s) to list"
  3445.       SUBROUTINE.PARAMETER = 1
  3446.       CALL TGET
  3447.       IF SUBROUTINE.PARAMETER = -1 OR Q = 0 THEN _
  3448.          EXIT SUB
  3449.       B = 1
  3450. 20142 LAST.INDEX = Q
  3451.       ANS.INDEX = B
  3452.       VIOLATION$ = "View ARC"
  3453.       FOR ARC.INDEX = ANS.INDEX TO LAST.INDEX
  3454.          GOSUB 20143
  3455.       NEXT
  3456.       EXIT SUB
  3457. 20143 Z$ = B$(ARC.INDEX)
  3458.       CALL ALLCAPS (Z$)
  3459.       CALL BRKFNAME (Z$,DRV$,PREFIX$,EXT$,FALSE)
  3460.       IF EXT$ = "" THEN _
  3461.          Z$ = Z$ + _
  3462.               ".ARC" _
  3463.       ELSE IF EXT$ <> "ARC" THEN _
  3464.               CALL QTPUT ("Only .ARC files can be viewed",1) : _
  3465.               RETURN
  3466.       FILE.NAME.HOLD$ = Z$
  3467.       FILE.NAME$ = Z$
  3468.       CALL BADFILE (PREFIX$,BAD.FILE.NAME.INDEX)
  3469.       ON BAD.FILE.NAME.INDEX GOTO 20144,20146,20147
  3470. 20144 CALL BADFILE (FILE.NAME$,BAD.FILE.NAME.INDEX)
  3471.       ON BAD.FILE.NAME.INDEX GOTO 20145,20146,20147
  3472. 20145 CALL ROTORSDIR (FILE.NAME$,SUBDIR$(),SUBDIR.COUNT + (NOT SYSOP),TRUE)
  3473.       IF OK THEN _
  3474.          GOTO 20148
  3475. 20146 Z$ = B$(ARC.INDEX) + _
  3476.            " not found!"
  3477.       CALL UPDTCALR (Z$,2)
  3478.       A$ = Z$ + _
  3479.            " Type correct filename" + PRESS.ENTER.EXPERT$
  3480.       SUBROUTINE.PARAMETER = 1
  3481.       CALL TGET
  3482.       IF SUBROUTINE.PARAMETER = -1 OR Q = 0 THEN _
  3483.          RETURN
  3484.       B$(ARC.INDEX) = B$(1)
  3485.       GOTO 20143
  3486. 20147 CALL SVIOLATION
  3487.       IF DENY.ACCESS THEN _
  3488.          EXIT SUB
  3489.       GOTO 20146
  3490. 20148 CALL QTPUT(FILE.NAME.HOLD$ + " has these files",1)
  3491.       CALL VIEWARC
  3492.       IF SUBROUTINE.PARAMETER = -1 THEN _
  3493.          ARC.INDEX = LAST.INDEX + 1
  3494.       RETURN
  3495.       END SUB
  3496. ' $SUBTITLE: 'BADNAME - subroutine to find bad file names'
  3497. ' $PAGE
  3498. '
  3499. '  SUBROUTINE NAME    -- BADNAME
  3500. '
  3501. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  3502. '                        ACTIVE.MESSAGE.FILE$
  3503. '                        ACTIVE.USER.FILE$
  3504. '                        CALLERS.FILE$
  3505. '                        COMMENTS.FILE$
  3506. '                        CONFIG.FILEANAME$
  3507. '                        MAIN.MESSAGE.BACKUP$
  3508. '                        MAIN.MESSAGE.FILE$
  3509. '                        MAXIMUM.VIOLATIONS
  3510. '                        PASSWORDS.FILE$
  3511. '                        RBBS.BAT$
  3512. '                        RCTTY.BAT$
  3513. '                        SUBDIR$()
  3514. '                        SUBDIR.INDEX
  3515. '                        VIOLATION$
  3516. '                        VIOLATIONS.THIS.SESSION
  3517. '                        Z$                          NAME OF FILE
  3518. '
  3519. '  OUTPUT PARAMETERS  -- BAD.FILE.NAME.INDEX         1 = FILE NAME IS OK
  3520. '                                                    2 = SECURITY BREACH TRIED
  3521. '                        VIOLATIONS.THIS.SESSION     NUMBER OF VIOLATIONS
  3522. '                        FILENAME$                   NAME OF FILE
  3523. '
  3524. '  SUBROUTINE PURPOSE -- TO PROTECT RBBS-PC AGAINST THE USE OF BAD FILE NAMES
  3525. '                        TO EITHER CRASH THE SYSTEM OR TO BREACH RBBS-PC'S
  3526. '                        SECURITY
  3527. '
  3528.       SUB BADNAME (BAD.FILE.NAME.INDEX) STATIC
  3529. '
  3530. ' *
  3531. ' *  TEST FOR SYSTEM FILE ATTEMPT                                             *
  3532. ' *
  3533. 20235 BAD.FILE.NAME.INDEX = 1
  3534.       Z$ = FILE.NAME$
  3535.       IF INSTR(3,FILE.NAME$,MID$(ACTIVE.MESSAGE.FILE$,3,(LEN(ACTIVE.MESSAGE.FILE$) - 2))) THEN _
  3536.          GOTO 20236
  3537.       IF INSTR(3,FILE.NAME$,MID$(ACTIVE.USER.FILE$,3,(LEN(ACTIVE.USER.FILE$) - 2))) THEN _
  3538.          GOTO 20236
  3539.       IF INSTR(3,FILE.NAME$,MID$(ACTIVE.USER.FILE$ + ".BAK",3,(LEN(ACTIVE.USER.FILE$ + ".BAK") - 2))) THEN _
  3540.          GOTO 20236
  3541.       IF LEN(CALLERS.FILE$) > 2 THEN _
  3542.          IF INSTR(3,FILE.NAME$,MID$(CALLERS.FILE$,3,(LEN(CALLERS.FILE$) - 2))) THEN _
  3543.             GOTO 20236
  3544.       IF INSTR(3,FILE.NAME$,MID$(COMMENTS.FILE$,3,(LEN(COMMENTS.FILE$) - 2))) THEN _
  3545.          GOTO 20236
  3546.       IF INSTR(3,FILE.NAME$,MID$(FILESEC.FILE$,3,(LEN(FILESEC.FILE$) - 2))) THEN _
  3547.          GOTO 20236
  3548.       IF INSTR(3,FILE.NAME$,MID$(MAIN.MESSAGE.BACKUP$,3,(LEN(MAIN.MESSAGE.BACKUP$) - 2))) THEN _
  3549.          GOTO 20236
  3550.       IF INSTR(3,FILE.NAME$,MID$(MAIN.MESSAGE.FILE$,3,(LEN(MAIN.MESSAGE.FILE$) - 2))) THEN _
  3551.          GOTO 20236
  3552.       IF INSTR(3,FILE.NAME$,MID$(MAIN.USER.FILE$,3,(LEN(MAIN.USER.FILE$) - 2))) THEN _
  3553.          GOTO 20236
  3554.       IF INSTR(3,FILE.NAME$,MID$(MAIN.USER.FILE$ + ".BAK",3,(LEN(MAIN.USER.FILE$ + ".BAK") - 2))) THEN _
  3555.          GOTO 20236
  3556.       IF INSTR(3,FILE.NAME$,MID$(PASSWORDS.FILE$,3,(LEN(PASSWORDS.FILE$) - 2))) THEN _
  3557.          GOTO 20236
  3558.       IF INSTR(3,FILE.NAME$,MID$(RBBS.BAT$,3,(LEN(RBBS.BAT$) - 2))) THEN _
  3559.          GOTO 20236
  3560.       IF INSTR(3,FILE.NAME$,MID$(RCTTY.BAT$,3,(LEN(RCTTY.BAT$) - 2))) THEN _
  3561.          GOTO 20236
  3562.       CALL BRKFNAME (CONFIG.FILENAME$,DR$,PREFIX$,EXTENSION$,FALSE)
  3563.       IF INSTR(3,FILE.NAME$,MID$(CONFIG.FILENAME$,LEN(DR$) + 1)) THEN _
  3564.          GOTO 20236
  3565.       EXIT SUB
  3566. 20236 BAD.FILE.NAME.INDEX = 2
  3567.       END SUB
  3568. ' $SUBTITLE: 'BRKFNAME - subroutine to split file name into components'
  3569. ' $PAGE
  3570. '
  3571. '  SUBROUTINE NAME    -- BRKFNAME
  3572. '
  3573. '  INPUT PARAMETERS   -- PARAMETER                    MEANING
  3574. '                        FILENAME$        FULL NAME OF FILE
  3575. '                        FOR.JOINING      TRUE IF WANT PARTS FORMATTED FOR
  3576. '                                           FORMING FILE NAMES
  3577. '  OUTPUT PARAMETERS  -- DRVPATH$         DRIVE AND PATH
  3578. '                        PREFIX$          PREFIX OF FILE NAME
  3579. '                        EXTENSION$       EXTENSION OF FILE NAME
  3580. '
  3581. ' (E.G. "C:\RBBS\ARCE.COM" HAS "C:\RBBS" AS DRIVE AND PATH,
  3582. '                              "ARCE"    AS PREFIX OF THE FILE NAME, AND
  3583. '                              "COM"     AS THE EXTENSION OF THE FILE NAME.
  3584. '
  3585. ' JOINED FORMAT IS C:\RBBS\,ARCE,.COM
  3586. '
  3587. '  SUBROUTINE PURPOSE -- TO BREAK A FILE NAME INTO ITS COMPONENT PARTS
  3588. '                        OF DRIVE/PATH, PREFIX, AND EXTENSION
  3589. '
  3590. '
  3591.       SUB BRKFNAME (FILENAME$,DRVPATH$,PREFIX$,EXTENSION$,FOR.JOINING) STATIC
  3592. 20282 CALL ALLCAPS (FILENAME$)
  3593.       DRVPATH$ = ""
  3594.       PREFIX$ = ""
  3595.       EXTENSION$ = ""
  3596.       CALL TRIMTRAIL (FILENAME$,"\")
  3597.       L = LEN(FILENAME$)
  3598.       IF L < 1 THEN _
  3599.          EXIT SUB
  3600.       CALL FINDLAST (FILENAME$,"\",X,Y)
  3601.       IF X < 1 THEN _
  3602.          IF MID$(FILENAME$,2,1) = ":" THEN _
  3603.             DRVPATH$ = LEFT$(FILENAME$,1) : _
  3604.             S = 3 _
  3605.          ELSE S = 1 _
  3606.       ELSE DRVPATH$ = LEFT$(FILENAME$,X-1) : _
  3607.            S = X + 1
  3608.       X = INSTR(FILENAME$ + ".",".")
  3609.       IF X < L THEN _
  3610.          EXTENSION$ = MID$(FILENAME$,X + 1,3)
  3611.       IF S <= L THEN _
  3612.          IF X >= S THEN _
  3613.             PREFIX$ = MID$(FILENAME$,S,X - S)
  3614.       IF NOT FOR.JOINING THEN _
  3615.          EXIT SUB
  3616.       IF LEN(DRVPATH$) = 1 THEN _
  3617.          DRVPATH$ = DRVPATH$ + _
  3618.                     ":"
  3619.       IF INSTR(DRVPATH$,"\") > 0 THEN _
  3620.          DRVPATH$ = DRVPATH$ + _
  3621.                     "\"
  3622.       IF LEN(EXTENSION$) > 0 THEN _
  3623.          EXTENSION$ = "." + _
  3624.                       EXTENSION$
  3625.       END SUB
  3626. ' $SUBTITLE: 'WILDCARD -- Matches string to a pattern'
  3627. ' $PAGE
  3628. '  SUBROUTINE NAME    -- WILDCARD
  3629. '
  3630. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  3631. '                        PATTERN$           PATTERN TO CHECK
  3632. '                        STRNG$             STRING TO FIE
  3633. '
  3634. '  OUTPUT PARAMETERS  -- OK                 TRUE IF MATCH FOUND
  3635. '                                           FALSE IF NO MATCH WAS FOUND
  3636. '
  3637. '  SUBROUTINE PURPOSE  DETERMINE WHETHER A STRING IS AN INSTANCE IN A PATTERN
  3638. '                      SUPPORTED PATTERNS ARE ONLY "?" WHICH REQUIRES A
  3639. '                      CHARACTER BUT CAN BE ANY, AND "*" WHICH MATCHES ANY-
  3640. '                      THING, INCLUDING A NULL STRING.  ANYTHING ELSE IN A
  3641. '                      MUST BE AN EXACT MATCH.
  3642. '
  3643. '
  3644.       SUB WILDCARD (PATTERN$,STRNG$) STATIC
  3645. 20285 OK = TRUE
  3646.       K = 0
  3647.       L = LEN(STRNG$)
  3648. 20286 K = K + 1
  3649.       IF K > L THEN _
  3650.          GOTO 20288
  3651.       B$ = MID$(PATTERN$,K,1)
  3652.       IF B$ = "*" THEN _
  3653.          EXIT SUB
  3654. 20287 IF B$ <> "?" AND MID$(STRNG$,K,1) <> B$ THEN _
  3655.          OK = FALSE : _
  3656.          EXIT SUB
  3657.       GOTO 20286
  3658. 20288 IF L < LEN(PATTERN$) AND MID$(PATTERN$,L + 1,1) <> "*" THEN _
  3659.          OK = FALSE
  3660.       END SUB
  3661.